CODEWITHSUNDEEP
vbaexcel
jeangelj
jeangelj

Reputation: 4498

excel vba merge multiple sheets from multiple workbooks into one workbook

I have two excel workbooks and I need to take a set of sheets from one and a set of sheets form another and save it as a new workbook. Since I will be doing this weekly, I would like to save it as a macro/vba.

I found this code online and edited it, but it is not working. 

Sub CopySheets()
    Dim wkb As Workbook
    Dim sWksName As String

sWksName = "Store 1"
For Each wkb In Workbooks
    If wkb.Name <> ThisWorkbook.Name Then
        wkb.Worksheets(sWksName).Copy _
          Before:=ThisWorkbook.Sheets(1)
    End If
Next
Set wkb = Nothing

    sWksName = "Store 3"
For Each wkb In Workbooks
    If wkb.Name <> ThisWorkbook.Name Then
        wkb.Worksheets(sWksName).Copy _
          Before:=ThisWorkbook.Sheets(1)
    End If
Next
Set wkb = Nothing

    sWksName = "Store 30"
For Each wkb In Workbooks
    If wkb.Name <> ThisWorkbook.Name Then
        wkb.Worksheets(sWksName).Copy _
          Before:=ThisWorkbook.Sheets(1)
    End If
Next
Set wkb = Nothing

    sWksName = "Store 33"
For Each wkb In Workbooks
    If wkb.Name <> ThisWorkbook.Name Then
        wkb.Worksheets(sWksName).Copy _
          Before:=ThisWorkbook.Sheets(1)
    End If
Next
Set wkb = Nothing


End Sub

I have to have both workbooks open, which is no problem. The sheet "Store 1" gets copied fine and then it stops and when I click on debug, it tells me that there is an error with this line

 wkb.Worksheets(sWksName).Copy _
              Before:=ThisWorkbook.Sheets(1)

Error message: "Script out of range"

Upvotes: 0

Views: 1366

Answers (1)

tigeravatar
tigeravatar

Reputation: 26640

Sub CopySheets()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim sWsNames As String

    sWsNames = "Store 1,Store 3,Store 30,Store 33"

    For Each wb In Workbooks
        If wb.Name <> ThisWorkbook.Name Then
            For Each ws In wb.Sheets
                If InStr(1, "," & sWsNames & ",", "," & ws.Name & ",", vbTextCompare) > 0 Then
                    ws.Copy Before:=ThisWorkbook.Sheets(1)
                End If
            Next ws
        End If
    Next

End Sub

Upvotes: 2

Related Questions