CODEWITHSUNDEEP
excelvba
Syertim
Syertim

Reputation: 157

Copying Rows from multiple sheets into another sheet with VBA

I'm trying to merge many sheets into a big one. This is the part of the macro where i loop over the sheets and try to copy the data from every sheet in to the big one.

 For Each sh In ActiveWorkbook.Worksheets          
        Dim lr As Long, rng As Range
        lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
        Set rng = sh.Range("A2:A" & lr)
        rng.EntireRow.Copy Bigsheet.Cells(Rows.Count, 1).End(xlUp)(2)
                   
 Next

but i don't know why i can't copy the entire rows, this seems to copy only a column

Upvotes: 0

Views: 724

Answers (1)

Tomasz
Tomasz

Reputation: 426

try my solution for Your case.

Sub MergeSheets()
    Dim wb As Workbook
    Dim ws_BigSheet As Worksheet, ws As Worksheet
    Dim lng_LastRow As Long, lng_LastColumn As Long, lng_LastRowBigSheet As Long
    Dim rng_WorkRange As Range
    
    Set wb = ThisWorkbook
    Set ws_BigSheet = wb.Worksheets("") '   big sheet name here
    
    For Each ws In wb.Worksheets
        If ws.Name <> ws_BigSheet.Name Then
            lng_LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
            lng_LastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column
            lng_LastRowBigSheet = ws_BigSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
            
            Set rng_WorkRange = ws.Range(ws.Cells(1, 1), ws.Cells(lng_LastRow, lng_LastColumn))
            rng_WorkRange.Copy ws_BigSheet.Range("A" & lng_LastRowBigSheet)
        End If  '   If ws.Name <> ws_BigSheet.Name
    Next ws
End Sub

Upvotes: 1

Related Questions