Home > other >  Pasting Worksheets Data from each sheet in One column - VBA
Pasting Worksheets Data from each sheet in One column - VBA

Time:07-28

i have code:

    Dim wksSrc As Worksheet
    Dim wksDst As Worksheet
    Dim rgSrc As Range
    Dim rgDst As Range
    Dim lrgRow As Long
    Dim lrgSrcRow As Long
    
    
    Set wksDst = ThisWorkbook.Worksheets("CheckP")
    lrgRow = wksDst.Cells(Rows.count, 1).End(xlUp).row
    
    Set rgDst = wksDst.Cells(lrgRow, 1)
    
    For Each wksSrc In ThisWorkbook.Worksheets
         If wksSrc.Name <> "Config" And wksSrc.Name <> "Summary" And wksSrc.Name <> "CheckP" Then
            lrgSrcRow = wksSrc.Cells(Rows.count, "B").End(xlUp).row
            With wksSrc
                wksSrc.Range("A2:B" & wksSrc.Cells(wksSrc.Rows.count, "B").End(xlUp).row).Copy Destination:=rgDst
            End With
            
            lrgRow = wksDst.Cells(Rows.count, 1).End(xlUp).row
            Set rngDst = wksDst.Cells(lrgRow   1, 1)
            
        End If
        
    Next wksSrc

End Sub

1. I do not understand why the data that is copied in the file do not paste under the new last cell, but overwrite. like that: enter image description here

The purpose of the code is:

From each worksheet other than Summary, Config and CheckP copied columns A and B and pasted them to the CheckP worksheet as an aggregate column

Could someone please help me improve this?

CodePudding user response:

Not sure why you need to set the destination range each time, you already define a destination reference in lrgRow. You can try to replace the destination as per below

Dim wksSrc As Worksheet
Dim wksDst As Worksheet
Dim rgSrc As Range
Dim rgDst As Range
Dim lrgRow As Long
Dim lrgSrcRow As Long


Set wksDst = ThisWorkbook.Worksheets("CheckP")
lrgRow = wksDst.Cells(Rows.Count, 1).End(xlUp).Row

Set rgDst = wksDst.Cells(lrgRow, 1)


For Each wksSrc In ThisWorkbook.Worksheets
     If wksSrc.Name <> "Config" And wksSrc.Name <> "Summary" And wksSrc.Name <> "CheckP" Then
        lrgSrcRow = wksSrc.Cells(Rows.Count, "B").End(xlUp).Row
        With wksSrc
            wksSrc.Range("A2:B" & lrgSrcRow).Copy Destination:=wksDst.Range("A" & lrgRow)
        End With
        
        lrgRow = wksDst.Cells(Rows.Count, 1).End(xlUp).Row
        Set rngDst = wksDst.Cells(lrgRow   1, 1)
        
    End If
    
Next wksSrc
  • Related