CODEWITHSUNDEEP
excelvba
Typicalusername
Typicalusername

Reputation: 33

Consolidate 650 worksheets in the same workbook down to one page

This code gives me everything from all the sheets and not even in a way that columns are matched up. I made a VBA script the took all 127 individual excell sheets and combined them into one workbook with 600+ sheets. I want only the 127 sheets called "Function Dependency" numbered blank - 127 to be combined into one sheet. The columns sometimes have useless data in the first row but otherwise have similar columns. Is there a better way to do this??

Sub MergeAll()
Dim r As Long, ws As Worksheet, rAll As Long, wsAll As Worksheet
Dim i As Long

Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.name = "All"
Set wsAll = ActiveSheet
rAll = 2
For Each ws In Worksheets
If ws.name <> "All" Then
    r = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    For i = 1 To r
        wsAll.Cells(rAll, 1) = ws.name
        wsAll.Cells(rAll, 2) = ws.Cells(i, 1)
        wsAll.Cells(rAll, 3) = ws.Cells(i, 2)
        rAll = rAll + 1
    Next i
End If
Next ws
End Sub

Upvotes: 0

Views: 49

Answers (1)

Tim Williams
Tim Williams

Reputation: 166306

Sub MergeAll()

    Dim r As Long, ws As Worksheet, rAll As Long, wsAll As Worksheet
    Dim i As Long, wb As Workbook

    Set wb = ThisWorkbook

    Set wsAll = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
    wsAll.name = "All"

    rAll = 2
    For Each ws In Worksheets
        If ws.name Like "Function Dependency*" Then

            r = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

            For i = 1 To r

                wsAll.Cells(rAll, 1).Resize(1, 3).value = _
                      Array(ws.name, ws.Cells(i, 1), ws.Cells(i, 2))

                rAll = rAll + 1
            Next i

        End If
    Next ws

End Sub

Upvotes: 4

Related Questions