Worksheets into Workbook [Solved/Closed]

Question

Worksheets into Workbook [Solved/Closed]

Report

Game Start Now

Posts: 138
Registration date: Thursday January 21, 2010
Status: Member
Last seen: May 8, 2019

- Dec 30, 2016 at 03:09 AM
Game Start Now

Posts: 138
Registration date: Thursday January 21, 2010
Status: Member
Last seen: May 8, 2019

- Jan 2, 2017 at 03:15 PM

Dear All,

I need to copy each worksheet into workbooks and saved in the specific path except 04 worksheets named NMS, MS, Master and Missing. Further, I need to copy the remaining 04 sheets named mentioned above into each workbook created with macro above.
and all worksheets must be protected with the same password.

Kindly help me in this matter ASAP.

Regards,
Game Start Now

Worksheets into Workbook
Vba add worksheet to workbook - How-To - Excel
Excel vba copy worksheet to another workbook without opening ✓ - Forum - Excel
How to automatically update one excel worksheet from another workbook ✓ - Forum - Excel
Vba copy worksheet to another workbook - How-To - Excel
Transfer Data Between Excel Spreadsheets - How-To - Excel

1 reply

Ask a question

TrowaD · Answer 1 · 2017-01-02T11:47:58-0500

Hi GSN,

This is what I got for you:

The name of the new workbook will be the one of the sheet that is copied to it.
The new workbook is saved in the same folder as your starting file.
All worksheets that are password protected will remain so.
The empty sheet is deleted on code line 16. In English it's called "Sheet1". Don't know if you use an english version, otherwise you need to change the sheets reference.

Here is the code:

Sub RunMe()
Dim ws As Worksheet
Dim shName As String

For Each ws In Worksheets
    If ws.Name <> "NMS" And ws.Name <> "MS" And _
    ws.Name <> "Master" And ws.Name <> "Missing" Then
        ws.Select
        shName = ws.Name
        Workbooks.Add
        
        ThisWorkbook.ActiveSheet.Copy _
        after:=ActiveWorkbook.Sheets(Sheets.Count)
        
        Application.DisplayAlerts = False
        Sheets("Sheet1").Delete
        Application.DisplayAlerts = True
        
        ThisWorkbook.Sheets("NMS").Copy _
        after:=ActiveWorkbook.Sheets(Sheets.Count)
        ThisWorkbook.Sheets("MS").Copy _
        after:=ActiveWorkbook.Sheets(Sheets.Count)
        ThisWorkbook.Sheets("Master").Copy _
        after:=ActiveWorkbook.Sheets(Sheets.Count)
        ThisWorkbook.Sheets("Missing").Copy _
        after:=ActiveWorkbook.Sheets(Sheets.Count)
        
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path _
        & "\" & shName & ".xlsx"
        ActiveWorkbook.Close
    End If
Next ws
End Sub

Best regards,
Trowa
Monday, Tuesday and Thursday are usually the days I'll respond. Bear this in mind when awaiting a reply.

Worksheets into Workbook [Solved/Closed]

1 reply

Your reply

Subscribe To Our Newsletter!