VBA to call the current workbook 2

[mpm32]

I have a workbook where at the end of each month it is saved as the next month. For example this month I have 01-Jan SGA.xls next month I will save this as 02-Feb SGA.xls.

I made this macro that will take some of the sheets, copy them into a new workbook, name the new workbook and then copy the values over onto the new sheet. This works fine - this month, in the code it references the 01-Jan.xls file. Next month when I run the macro it will be from the 02-Feb SGA.xls file.

How do I write the code to call the sheets regardless what the file name is?

I would also like to have the new workbook be named "AR 01-Jan SGA.xls" or whatever the month is. Is there a way to do that as well?

Here's the code

Sub ARsheetCreation()
'
' ARsheetCreation Macro
'

'
    Sheets(Array("7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", _
        "TotalARBilling.T")).Select
    Sheets("TotalARBilling.T").Activate
    Sheets(Array("7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", _
        "TotalARBilling.T")).Copy
    ActiveWorkbook.SaveAs Filename:="C:\AR SGA.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    Windows("01-Jan SGA.xls").Activate
    Range("B9:S58").Select
    Selection.Copy
    Windows("AR SGA.xls").Activate
    Range("B9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    ActiveWorkbook.Save
    ActiveWindow.Close
End Sub

 

[SkipVought]

hi,

Sub ARsheetCreation()
'
' ARsheetCreation Macro
'

'
   Dim wbNEW As Workbook, dte As Date
    
    Sheets(Array("7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", _
        "TotalARBilling.T")).Copy
   '"AR 01-Jan SGA.xls
   '[b]
    dte = Date   'how do you define your date???[/b]
   
    Set wbNEW = ActiveWorkbook.SaveAs(Filename:="C:\AR "[b] & Format(dte, "mm-mmm") & [/b]"SGA.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False)
        
    ThisWorkbook.Range("B9:S58").Copy
    
    With wbNEW
        .ActiveSheet.Range("B9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        .Save
        .Close
    End With
End Sub

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[mpm32]

Each month would be named the previous month from the current one

So in this month, the file would be named 01-Jan SGA.xlx in March, 02-Feb SGA.xls.

Can I call the name from a cell within the workbook? I do have a sheet where I look-up various date formats, I could put them there?

It looks up the period and returns the Date depending on where in the workbook that format is needed. It's called DateTable and I could put the names for each month's new sheets in a new column there?

Period Month End Date Year Full Date Date MonthYear
001 January 31 2011 January 31, 2011 1/31/2011 January 2011
002 February 28 2011 February 28, 2011 2/28/2011 February 2011
003 March 31 2011 March 31, 2011 3/31/2011 March 2011
004 April 30 2011 April 30, 2011 4/30/2011 April 2011
005 May 31 2011 May 31, 2011 5/31/2011 May 2011
006 June 30 2011 June 30, 2011 6/30/2011 June 2011
007 July 31 2011 July 31, 2011 7/31/2011 July 2011
008 August 31 2011 August 31, 2011 8/31/2011 August 2011
009 September 30 2011 September 30, 2011 9/30/2011 September 2011
010 October 31 2011 October 31, 2011 10/31/2011 October 2011
011 November 30 2011 November 30, 2011 11/30/2011 November 2011
012 December 31 2011 December 31, 2011 12/31/2011 December 2011

 

[SkipVought]

I would store the date relating to the report name in a NAMED RANGE cell, for instance RptDte

then in the code

dte = [RptDte]
[RptDte] = DateSerial(Year([RptDte]),month[RptDte])+1,1)

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[mpm32]

OK, I made a named range called RptDate on the sheet DateTable that will change each month depending on some other cells value. I tried this code but I'm getting a compile error on .SaveAs

' ARsheetCreation Macro
'

'
   Dim wbNEW As Workbook, dte As Date
    
    Sheets(Array("7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", _
        "TotalARBilling.T")).Copy
   
   dte = [RptDte]
   
    Set wbNEW = ActiveWorkbook.SaveAs(Filename:="C:\AR " & dte & "SGA.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False)
        
    ThisWorkbook.Range("B9:S58").Copy
    
    With wbNEW
        .ActiveSheet.Range("B9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        .Save
        .Close
    End With
End Sub

 

[SkipVought]

   Dim wbNEW As Workbook, dte As Date
    
    Sheets(Array("7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", _
        "TotalARBilling.T")).Copy
   
   dte = [RptDte]
   
   Set wbNEW = ActiveWorkbook   

   wbNEW.SaveAs(Filename:="C:\AR " & dte & "SGA.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False)
        
    ThisWorkbook.[b]Worksheets([red]"WhatSheet???"[/red])[/b].Range("B9:S58").Copy
    
    With wbNEW
        .ActiveSheet.Range("B9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        .Save
        .Close
    End With

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[mpm32]

The sheet(s) would be;

Sheets(Array("7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", _
"TotalARBilling.T"))

 

[SkipVought]

HUH?

Please consider again!

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[mpm32]

Not sure I'm understanding.

I want the macro to select the array of sheets, copy those to a new workbook, name the new workbook, go back to the original workbook, select range B9:S58 on the first sheet of the group of sheets, copy that and paste the values in the same range on the sheets in the newly created workbook.

Thinking about this, what I'm trying here may be a roundabout way to do what I need it to do.

The problem arises when I copy the sheets from my original workbook, to a new workbook. As a large portion of cells on my sheets use this formula (which you helped me with) - =SUMPRODUCT((INDIRECT($A$3&"!$D$5:$O$5")<=$A$7)*(INDIRECT($A$3&"!D11:O11"))) I get #REF errors on the pasted sheets.

Maybe there's a way to select the array of sheets and paste the formats and values into the new sheets without the other extra steps. When I right click on the sheet array there is no option to paste only values and formats, maybe through code? I also don't want the formulas showing as these new books are emailed out and there is no need for the recipients to see the formulas.

 

[SkipVought]

I want the macro to select the array of sheets, copy those to a new workbook, name the new workbook, go back to the original workbook, select range B9:S58 on the [red]first sheet of the group of sheets[/red], copy that and paste the values in the same range on the sheets in the newly created workbook.

    ThisWorkbook.Worksheets([b][red]"WhatSheet???"[/red][/b]).Range("B9:S58").Copy

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[mpm32]

ThisWorkbook.Worksheets("7210544.T").Range("B9:S58").Copy Right?

 

[SkipVought]

It appears so.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[mpm32]

Still getting a compile error;

Dim wbNEW As Workbook, dte As Date
    
    Sheets(Array("7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", _
        "TotalARBilling.T")).Copy
   
   dte = [RptDte]
   
   Set wbNEW = ActiveWorkbook

   [COLOR=red yellow]wbNEW.SaveAs(Filename:="C:\AR " & dte & "SGA.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False)[/color]
        
    ThisWorkbook.Worksheets("7210544.T").Range("B9:S58").Copy
    
    With wbNEW
        .ActiveSheet.Range("B9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        .Save
        .Close
    End With
End Sub

 

[PHV]

Either:
Call wbNEW.SaveAs(Filename:="C:\AR " & dte & "SGA.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False)
or:
wbNEW.SaveAs Filename:="C:\AR " & dte & "SGA.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[SkipVought]

Loose the parentheses.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[mpm32]

Getting a type mismatch error 13 now. I made sure that the cell that RptDte is stored is formatted as text but I still get the error.

ARsheetCreation Macro
'

'
   Dim wbNEW As Workbook, dte As Date
    
    Sheets(Array("7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", _
        "TotalARBilling.T")).Copy
   
   [COLOR=red yellow]dte = [RptDte][/color]
   
   Set wbNEW = ActiveWorkbook

    wbNEW.SaveAs Filename:="C:\AR " & dte & "SGA.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
        
    ThisWorkbook.Worksheets("7210544.T").Range("B9:S58").Copy
    
    With wbNEW
        .ActiveSheet.Range("B9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        .Save
        .Close
    End With
End Sub

 

[SkipVought]

Is that cell NAMED RptDte

Use the Name Box to be sure!

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[mpm32]

Yes, I named it RptDte in the Name Box, when I check it, the cell comes up as RptDte in the name box. I also checked the cell reference in the define name form.

 

[SkipVought]

If you did everything as stated, there should be no missmatch!

Use the Watch Window to observe the actual value of RptDte in your code

faq707-4594

BTW, what is the numeric format of RptDte on the sheet?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[mpm32]

Thanks for the watch window tip. I was able to determine some things.

Dim wbNEW As Workbook, dte As Date I think the as date is causing the type mismatch error. I tried As Variant and it works when I put a value into the dte= line.

When I try to change to this dte = [RptDte] I get a type mismatch error but on the highlighted section.

Sub ARsheetCreation()
'
' ARsheetCreation Macro
'

'
   Dim wbNEW As Workbook, dte As Variant
    
    Sheets(Array("7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", _
        "TotalARBilling.T")).Copy
   
   dte = [RptDte]
   
   Set wbNEW = ActiveWorkbook

    [COLOR=red yellow]wbNEW.SaveAs Filename:="C:\AR " & dte & "SGA.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False[/color]
        
    ThisWorkbook.Worksheets("7210544.T").Range("B9:S58").Copy
    
    With wbNEW
        .ActiveSheet.Range("B9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        .Save
        .Close
    End With
End Sub

This sort of works when I hard code the 03-Mar but I can't get it to use the value in the named range RptDte. I need to select sheets "7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", "TotalARBilling.T" instead of just "7210544.T in the line ThisWorkbook.Worksheets("7210544.T").Range("B9:S58").Copy because as is it only copies and pastes the values from that one sheet into the new workbook. I need it to copy that range from all sheets in the group and paste them into the new sheets.

Sub ARsheetCreation()
'
' ARsheetCreation Macro
'

'
   Dim wbNEW As Workbook, dte As Variant
    
    Sheets(Array("7210544.T", "7210528.T", "7210521.T", "3410800.T", "8xxxxxx.T", _
        "TotalARBilling.T")).Copy
   
   dte = "03-Mar"
   
   Set wbNEW = ActiveWorkbook

    wbNEW.SaveAs Filename:="C:\AR " & dte & "SGA.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
        
    [COLOR=red yellow]ThisWorkbook.Worksheets("7210544.T").Range("B9:S58").Copy[/color] [b]I need this range in all sheets copied[/b]
    
    With wbNEW
        .ActiveSheet.Range("B9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        .Save
        .Close
    End With
End Sub