VBA - Loop through worksheets and paste to a new workbook

sam20 · Oct 30th 2020

Hello, I need help with looping macro. I created below macro by recording it and works just fine. It is not as dynamic as I want it to be. If I need to add/delete worksheet, I will have to edit the macro which I don't want to do. What I need is to modify the following macro using a looping macro. Instead of using sheet(arrays) to list all the sheets in the macro, a name range, such as "reportsheets", would be more dynamic, more easy to update any changes to reporting sheet names. The list of "reportsheets" would be in the workbook in sheet name "MacroSheet". The workbook has about 95 sheets that includes all the data and reporting sheets.

The macro does the following:
- Make copy of all the "reportsheets" and paste special value to a new workbook
- Deletes name ranges in the new workbook except for "Print_Title" & "Print_Area" which I need
- Saves the file referencing "PathSave & FilenameSave" for file name and close
- Keeps the original workbook open

I would like a loop macro to do the above function. Hope I was clear enough.
Let me know if any further questions for clarification. This is my first time posting on the forum.

Code

Sub CreateFile()

Dim PathSave As String
Dim FilenameSave As String

    PathSave = Range("B3").Value
    FilenameSave = Range("B4").Value

Application.ScreenUpdating = False

    Sheets(Array("Cover", "Sum1", "Sum2", "Comp1", "Mix1", "StrWk1", "Comp2", "Mix2", _
        "StrWk2", "Comp3", "Mix3", "StrWk3", "Comp4", "Mix4", "StrWk4", "Comp5", "Mix5", _
        "StrWk5", "Comp6", "Mix6", "StrWk6", "Comp7", "Mix7", "StrWk7", "Comp8", "Mix8", _
        "StrWk8", "Comp9", "Mix9", "StrWk9", "Comp10", "Mix10", "StrWk10", "Comp11", "Mix11", _
        "StrWk11", "Comp13", "Mix13", "StrWk13", "Comp14", "Mix14", "StrWk14", "Comp15", _
        "Mix15", "StrWk15", "Comp17", "Mix17", "StrWk17", "Comp18", "Mix18", "StrWk18", _
        "Comp19", "Mix19", "StrWk19", "Comp20", "Mix20", "StrWk20", "Comp21", "Mix21", _
        "StrWk21")).Select
    Sheets("Cover").Activate
    Sheets(Array("Cover", "Sum1", "Sum2", "Comp1", "Mix1", "StrWk1", "Comp2", "Mix2", _
        "StrWk2", "Comp3", "Mix3", "StrWk3", "Comp4", "Mix4", "StrWk4", "Comp5", "Mix5", _
        "StrWk5", "Comp6", "Mix6", "StrWk6", "Comp7", "Mix7", "StrWk7", "Comp8", "Mix8", _
        "StrWk8", "Comp9", "Mix9", "StrWk9", "Comp10", "Mix10", "StrWk10", "Comp11", "Mix11", _
        "StrWk11", "Comp13", "Mix13", "StrWk13", "Comp14", "Mix14", "StrWk14", "Comp15", _
        "Mix15", "StrWk15", "Comp17", "Mix17", "StrWk17", "Comp18", "Mix18", "StrWk18", _
        "Comp19", "Mix19", "StrWk19", "Comp20", "Mix20", "StrWk20", "Comp21", "Mix21", _
        "StrWk21")).Copy
    Sheets(Array("Cover", "Sum1", "Sum2", "Comp1", "Mix1", "StrWk1", "Comp2", "Mix2", _
        "StrWk2", "Comp3", "Mix3", "StrWk3", "Comp4", "Mix4", "StrWk4", "Comp5", "Mix5", _
        "StrWk5", "Comp6", "Mix6", "StrWk6", "Comp7", "Mix7", "StrWk7", "Comp8", "Mix8", _
        "StrWk8", "Comp9", "Mix9", "StrWk9", "Comp10", "Mix10", "StrWk10", "Comp11", "Mix11", _
        "StrWk11", "Comp13", "Mix13", "StrWk13", "Comp14", "Mix14", "StrWk14", "Comp15", _
        "Mix15", "StrWk15", "Comp17", "Mix17", "StrWk17", "Comp18", "Mix18", "StrWk18", _
        "Comp19", "Mix19", "StrWk19", "Comp20", "Mix20", "StrWk20", "Comp21", "Mix21", _
        "StrWk21")).Select
    Sheets("Cover").Activate
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Range("A1").Select
    Sheets("Cover").Select
    ActiveWorkbook.Names("District").Delete
    ActiveWorkbook.Names("DistrictName").Delete
    ActiveWorkbook.Names("FiscalWks").Delete
    ActiveWorkbook.Names("FYLY").Delete
    ActiveWorkbook.Names("FYTY").Delete
    ActiveWorkbook.Names("LOCATN").Delete
    ActiveWorkbook.Names("NonComp").Delete
    ActiveWorkbook.Names("PdWk").Delete
    ActiveWorkbook.Names("Period").Delete
    ActiveWorkbook.Names("StoreList").Delete
    ActiveWorkbook.Names("week").Delete
    ActiveWorkbook.Names("WkEndDate").Delete
    ActiveWorkbook.Names("WkNum").Delete
    ActiveWorkbook.SaveAs PathSave & FilenameSave, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close
    Sheets("MacroSheet").Select
    Range("A15").Select

Application.ScreenUpdating = True

End Sub

Display More

**royUK** · Oct 31st 2020

Attach an example workbook

**royUK** · Oct 31st 2020

Why not simply make a copy of the workbook? Then convert formulas to value and then delete unwanted tabs,

That would be much quicker.

**royUK** · Oct 31st 2020

Also, which sheet contains the cells for the file name and path?

sam20 · Oct 31st 2020

I can't attach a sample copy of the workbook. Confidential data in it and all the headers and titles reference the company.

I don't know much about writing vba codes. The one I did was a recorded macro. So modifying it to make it more efficient is where I fall short.

The file name and path is in sheet name: "MacroSheet". It is also where I added the macro button. Can you still help without the sample workbook?

Thanks royUK.

**royUK** · Nov 1st 2020

Try this

Code

Option Explicit


Sub CreateFile()
Dim nm As Name
Dim PathSave As String, FileNameSave As String


PathSave = Worksheets("MacroSheet").Range("B3").Value
If Right(PathSave, 1) <> "\" Then PathSave = PathSave & "\"
FileNameSave = Worksheets("MacroSheet").Range("B4").Value




Sheets(Array("Cover", "Sum1", "Sum2", "Comp1", "Mix1", "StrWk1", "Comp2", "Mix2", _
"StrWk2", "Comp3", "Mix3", "StrWk3", "Comp4", "Mix4", "StrWk4", "Comp5", "Mix5", _
"StrWk5", "Comp6", "Mix6", "StrWk6", "Comp7", "Mix7", "StrWk7", "Comp8", "Mix8", _
"StrWk8", "Comp9", "Mix9", "StrWk9", "Comp10", "Mix10", "StrWk10", "Comp11", "Mix11", _
"StrWk11", "Comp13", "Mix13", "StrWk13", "Comp14", "Mix14", "StrWk14", "Comp15", _
"Mix15", "StrWk15", "Comp17", "Mix17", "StrWk17", "Comp18", "Mix18", "StrWk18", _
"Comp19", "Mix19", "StrWk19", "Comp20", "Mix20", "StrWk20", "Comp21", "Mix21", _
"StrWk21")).Copy
Worksheets.Select
Cells.Select
Worksheets.Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Select
Application.CutCopyMode = False


On Error Resume Next
For Each nm In ActiveWorkbook.Names
Select Case nm.Name
Case "Print_Title", "Print_Area"
Case Else: nm.Delete
End Select
Next nm
On Error GoTo 0
'51 = xlOpenXMLWorkbook (without macro's in 2007-2016, xlsx)
'52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2016, xlsm)
'50 = xlExcel12 (Excel Binary Workbook in 2007-2016 with or without macro's, xlsb)
'56 = xlExcel8 (97-2003 format in Excel 2007-2016, xls)
ActiveWorkbook.SaveAs Filename:=PathSave & FileNameSave, FileFormat:=51
End Sub

Display More

sam20 · Nov 1st 2020

Thanks... royUK. This works but it deletes all the name ranges. I would like to keep "Print_Area" & Print_Titles" name ranges only. Also is it possible to use a loop to cycle through a list of the report sheets names instead of having it in an array? The list would be in the "MacroSheet" and named "ReportSheets". That is what I am look for is to make it more dynamic, where I can add/subtract report sheets and not have to go into the macro to make any changes.

sam20 · Nov 1st 2020

updating my prior reply royUK. I saw where you want to keep "Print_Titles" & "Print_Area". It just didn't work. When I ran the macro, it deleted all the name ranges.....sorry for not realizing it earlier.

**royUK** · Nov 2nd 2020

It shouldn't delete them

VBA - Loop through worksheets and paste to a new workbook

Participate now!

Share

Tags

Users Viewing This Thread