Home > Enterprise >  Simple loop does not paste ranges correctly
Simple loop does not paste ranges correctly

Time:10-20

I have a simple loop that should copy ranges form three sheets and stack them on top of each other in another sheet. I define the ranges of each of the three sheets via a cell that counts rows in the Control Sheet.

I do not get an error message, however only the range of the first sheets gets pasted. I troubleshooted already to see if the loop is running until end and indeed it does. I cannot wrap my head around why only the range from the first sheets gets pasted in the final sheet.

Sub Loop()

Dim ws_Sheet As Worksheet, ws As Worksheet
Dim lng_LastRow As Long, lng_LastColumn As Long, lng_LastRowSheet As Long
Dim rng_WorkRange As Range
Dim arrSht, i
Dim counter As Integer

arrSht = Array("a", "b", "c")

Set ws_Sheet = Worksheets("d")
ws_Sheet.Cells.ClearContents
counter = 1

For i = 0 To 2
    
    Set ws = Worksheets(arrSht(i))
    lng_LastRow = Worksheets("Control").Range("E" & counter).Value   1
    lng_LastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column
    lng_LastRowSheet = ws_Sheet.Cells(Rows.Count, 1).End(xlUp).Row

    Set rng_WorkRange = ws.Range(ws.Cells(1, 1), ws.Cells(lng_LastRow, lng_LastColumn))
    rng_WorkRange.Copy ws_Sheet.Range("A" & lng_LastRowSheet)
    counter = counter   1
    
Next i
 
End Sub

CodePudding user response:

The issue is

lng_LastRowSheet = ws_Sheet.Cells(Rows.Count, 1).End(xlUp).Row

is the last used row (the last row that has data).
And then you use that to start pasting

rng_WorkRange.Copy ws_Sheet.Range("A" & lng_LastRowSheet)

so you overwrite the last row of data!

The next free row is lng_LastRowSheet 1 so you should paste there:

rng_WorkRange.Copy ws_Sheet.Range("A" & (lng_LastRowSheet   1))

You can also see that in the debug data:

  • a $A$1:$B$338 to A1
  • b $A$1:$B$91 to A338
  • c $A$1:$B$356 to A428

a goes from A1:B338 but you start pasting b in A338 so it overwrites the last row of a.

CodePudding user response:

The counter and the lng_lastRow variable is too messy. I repaleced some code as follow:

Sub newLoop()

Dim ws_Sheet As Worksheet, ws As Worksheet
Dim lng_LastRow As Long, lng_LastColumn As Long, lng_LastRowSheet As Long
Dim rng_WorkRange As Range, rng_lastRange As Range
Dim arrSht, i
Dim counter As Integer

arrSht = Array("a", "b", "c")
Set ws_Sheet = Worksheets("Control")
ws_Sheet.Cells.ClearContents

For i = 0 To 2
    
    Set ws = Worksheets(arrSht(i))
    
    Set rng_lastRange = ws_Sheet.Cells(Rows.Count, 1).End(xlUp)
    
    lng_LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    lng_LastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column
    Set rng_WorkRange = ws.Range(ws.Cells(1, 1), ws.Cells(lng_LastRow, lng_LastColumn))
    
    rng_WorkRange.Copy rng_lastRange.Offset(1, 0)

Next i

End Sub

  • Related