Simple loop does not paste ranges correctly - excel

Question

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

Answer 1

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.
I gave it a test:
Created worksheet Control with data like
Then created worksheets a, b and c like
with data until row 500 so there is enough.
Then created an empty worksheet d for the output.
And used the following code. Note I have optimized it so it uses meaningful variable names, which is much easier to read, understand and debug.
Option Explicit
Public Sub CopyData()
Dim SheetNames() As Variant
SheetNames = Array("a", "b", "c")
Dim wsDestination As Worksheet
Set wsDestination = ThisWorkbook.Worksheets("d")
wsDestination.Cells.ClearContents
Dim i As Long
For i = 0 To 2
Dim wsSource As Worksheet
Set wsSource = ThisWorkbook.Worksheets(SheetNames(i))
Dim SourceLastRow As Long
SourceLastRow = ThisWorkbook.Worksheets("Control").Range("E" & i + 1).Value + 1
Dim SourceLastColumn As Long
SourceLastColumn = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column
Dim DestinationFreeRow As Long
DestinationFreeRow = wsDestination.Cells(wsDestination.Rows.Count, 1).End(xlUp).Row + 1 ' Last used row +1
Dim SourceRange As Range
Set SourceRange = wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(SourceLastRow, SourceLastColumn))
SourceRange.Copy wsDestination.Range("A" & DestinationFreeRow)
Next i
End Sub
And I get a perfect output like:
Note that in the output I have hidden some rows so you can see eveything is there. This code perfectly does what it is supposed to.

Answer 2

Stack Ranges (Vertically) From Multiple Worksheets
Sub StackRanges()
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Source
Dim sWorksheetNames() As Variant: sWorksheetNames = VBA.Array("a", "b", "c")
' Lookup (Source Last Row)?
Dim lws As Worksheet: Set lws = wb.Worksheets("Control")
Dim llrCell As Range: Set llrCell = lws.Range("E1")
' Destination
Dim dws As Worksheet: Set dws = wb.Worksheets("d")
dws.UsedRange.ClearContents
Dim dfCell As Range: Set dfCell = dws.Range("A1")
Dim sws As Worksheet
Dim srg As Range
Dim slRow As Long
Dim slColumn As Long
Dim i As Long
' Loop.
For i = 0 To UBound(sWorksheetNames)
Set sws = wb.Worksheets(sWorksheetNames(i))
slRow = llrCell.Value + 1
slColumn = sws.Cells(1, sws.Columns.Count).End(xlToLeft).Column
Set srg = sws.Range("A1", sws.Cells(slRow, slColumn))
srg.Copy dfCell
' If you only need to copy values (since you're using '.ClearContents'),
' instead, use the most efficient:
'dfCell.Resize(srg.Rows.Count, srg.Columns.Count).Value = srg.Value
Set llrCell = llrCell.Offset(1) ' next source last row lookup cell
Set dfCell = dfCell.Offset(srg.Rows.Count) ' next first dest. cell
Next i
End Sub

Answer 3

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