Use Any Filename in Macro Routine

[Charles]

I have enclosed below a small portion of a macro whose sole function is to
copy and paste the data from a master spreadsheet to a new excel file.

The challenge we are having is if the name of the master spreadsheet is not
"filename.xls" the routine does not work.

I am looking for assistance in how ANY file name can be used and the macro
knows to simply look in the active file. Please note that the macro uses 4
tabs within the work sheet.



Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+z
'
Workbooks.Add
Windows("FILENAME.xls").Activate
Sheets("TAB1").Select
Range("A1:C24").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Book1").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.PageSetup.PrintArea = "$A$1:$C$24"
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "TAB1"
Range("A1:C24").Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A$1:$C$24"
End With
End Sub

 

[Charles Chickering]

Like your name btw. Try this routine:
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+z
'
Dim wb1 As Workbook
Dim wb2 As Workbook

Application.CutCopyMode = False
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Add
wb1.Worksheets("TAB1").Range("A1:C24").Copy
wb2.Worksheets(1).Name = "TAB1"
With wb2.Worksheets("TAB1").Range("A1")
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
With wb2.Worksheets("TAB1").PageSetup
.PrintArea = "$A$1:$C$24"
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
wb2.Worksheets("TAB1").PageSetup.PrintArea = "$A$1:$C$24"
End Sub

 

[Charles]

Charles, ditto on the name and thank you for the help.

Given the TAB1, TAB2, TAB3, and TAB4 that are in the worksheet, do I need to
have similar language for each of the tabs?

Charles

 

[Charles Chickering]

What exactly are you trying to accomplish? If you are looping through each of
the sheets and copying data to a new workbook then I'd use a loop to reduce
the amount of code required to get this done. Something like this should get
you close:

Sub Macro1()

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim cnt As Long

Application.CutCopyMode = False
Set wb1 = ActiveWorkbook
For cnt = 1 To 4
Set ws = wb1.Worksheets("TAB" & cnt)
ws.Range("A1:C24").Copy
Set wb2 = Workbooks.Add
On Error Resume Next
Set ws2 = wb2.Worksheets(cnt)
If ws2 Is Nothing Then
Set ws2 = wb2.Worksheets.Add(After:=wb2.Sheets(wb2.Sheets.Count))
End If
On Error GoTo 0
ws2.Name = "TAB" & cnt
With ws2.Range("A1")
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
With ws2.PageSetup
.PrintArea = "$A$1:$C$24"
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Next
End Sub

 

[Charles Chickering]

Oops, we might want to move the workbooks.add out of the loop or we'll have 4
new workbooks running around...

Sub Macro1()

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim cnt As Long

Application.CutCopyMode = False
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Add
For cnt = 1 To 4
Set ws = wb1.Worksheets("TAB" & cnt)
ws.Range("A1:C24").Copy
On Error Resume Next
Set ws2 = wb2.Worksheets(cnt)
If ws2 Is Nothing Then
Set ws2 = wb2.Worksheets.Add(After:=wb2.Sheets(wb2.Sheets.Count))
End If
On Error GoTo 0
ws2.Name = "TAB" & cnt
With ws2.Range("A1")
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
With ws2.PageSetup
.PrintArea = "$A$1:$C$24"
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Next
End Sub