VBA Copy Sheets to New Workbook

[MikoSDS]

Hello Everyone,

I have a problem with copying specific worksheets to new workbooks, below is my code, but I don't know how to skip hidden sheets, something like If Worksheets.Visible = True Then do the code, would be great but I wonder if something like a list would be best choice. For example "-General" is the main sheet and sheets belongs to this are: "1" "2" "3"

Macro will copy only sheets which are in the A1:A4 range, so the hidden sheets will be skipped too! Thank you all for help!

[COLOR=#333333]Sub Report()    [/COLOR]    Dim Wb As Workbook
    Dim dateStr As String
    Dim NewWorkBookName As String
    Dim Links As Variant
    Dim i As Integer
    Dim v As Variant, ws As Worksheet
    Dim tmpV As Variant
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With
    
    ReDim v(1 To Sheets.Count)
    For Each ws In ThisWorkbook.Worksheets
        If LCase(Left(ws.Name, 1)) = "-" Then
            x = x + 1
            v(x) = ws.Name
        Else
            v(x) = v(x) & "," & ws.Name
        End If
    Next ws
    
    Set Wb = ActiveWorkbook
    dateStr = Format(Date, "MM-DD-YYYY")
    
    For a = 1 To x
        tmpV = Split(v(a), ",")
        NewWorkBookName = tmpV(0)
        
        Wb.Sheets(tmpV).Copy
        
        With ActiveWorkbook
            Links = .LinkSources(xlExcelLinks)
            If Not IsEmpty(Links) Then
                For i = 1 To UBound(Links)
                    .BreakLink Links(i), xlLinkTypeExcelLinks
                Next i
            End If
        End With
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & NewWorkBookName & " " & dateStr
        ActiveWorkbook.Close
    Next a
    
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
     
End Sub

 

[Steve_]

Hello Everyone,

I have a problem with copying specific worksheets to new workbooks, below is my code, but I don't know how to skip hidden sheets, something like If Worksheets.Visible = True Then do the code, would be great but I wonder if something like a list would be best choice. For example "-General" is the main sheet and sheets belongs to this are: "1" "2" "3"

Macro will copy only sheets which are in the A1:A4 range, so the hidden sheets will be skipped too! Thank you all for help!

[COLOR=#333333]Sub Report()    [/COLOR]    Dim Wb As Workbook
    Dim dateStr As String
    Dim NewWorkBookName As String
    Dim Links As Variant
    Dim i As Integer
    Dim v As Variant, ws As Worksheet
    Dim tmpV As Variant
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With
    
    ReDim v(1 To Sheets.Count)
    For Each ws In ThisWorkbook.Worksheets
        If LCase(Left(ws.Name, 1)) = "-" Then
            x = x + 1
            v(x) = ws.Name
        Else
            v(x) = v(x) & "," & ws.Name
        End If
    Next ws
    
    Set Wb = ActiveWorkbook
    dateStr = Format(Date, "MM-DD-YYYY")
    
    For a = 1 To x
        tmpV = Split(v(a), ",")
        NewWorkBookName = tmpV(0)
        
        Wb.Sheets(tmpV).Copy
        
        With ActiveWorkbook
            Links = .LinkSources(xlExcelLinks)
            If Not IsEmpty(Links) Then
                For i = 1 To UBound(Links)
                    .BreakLink Links(i), xlLinkTypeExcelLinks
                Next i
            End If
        End With
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & NewWorkBookName & " " & dateStr
        ActiveWorkbook.Close
    Next a
    
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
     
End Sub

Sub test()
    For Each Sh In ThisWorkbook.Sheets
        If Sh.Visible = -1 Then
            'do stuff
        End If
    Next Sh
End Sub

 

[Steve_]

"CodeName" is your friend when wanting to make sheets "special".

 

[Norie]

Which sheets do you want to copy?

 

[MikoSDS]

@Steve_ thank you for reply! Unfortunately it's still copying hidden sheets :/
@Norie I want to copy sheets listed in my screenshot, for example I would like to have a macro which is getting sheets names from Range(A1:A4) and then copying this specific sheets from this workbook to new workbook - I think, it's best option.

Thank you all!

 

[Norie]

Perhaps something like this then.

Sub CopySheets()
Dim col As Range
Dim arrShts As Variant

    For Each col In Sheets("List").Range("A1").CurrentRegion.Columns
    
        arrShts = Application.Transpose(col.Resize(Application.CountA(col)).Value)
        
        ThisWorkbook.Sheets(arrShts).Copy
        
    Next col
    
End Sub

 

[MikoSDS]

@Norie very nice! That's what I was looking for, but seems like this macro is not copying sheets from my list properly, so if I have only one sheet, for example "-general" in "A1" it's working properly, but when I add one more sheet for example "1" to "A2" it's copying my "general" sheet, but not the "1" just the main sheet "list" and if I'm adding something next to "A1", let's say in "B1" the macro is going wrong too. Can you help please? Thank you!

P.S I've attached the excel file

https://ufile.io/m6swda9k

 

[Norie]

The problem is that Excel is seeing sheet names like 1, 2 etc as sheet indexes.

So when you have 1 in A2 it's copying the sheet with index 1, i.e. the List sheet.

This update should fix things.

Sub CopySheets()
Dim col As Range
Dim arrShts As Variant
Dim I As Long

    For Each col In Sheets("List").Range("A1").CurrentRegion.Columns
                        
                        
        arrShts = Application.Transpose(col.Resize(Application.CountA(col)).Value)
        
        For I = LBound(arrShts) To UBound(arrShts)
            arrShts(I) = CStr(arrShts(I))
        Next I
        
        ThisWorkbook.Sheets(arrShts).Copy
        
    Next col
    
End Sub

 

[MikoSDS]

Great! It's perfect now. Thank you!