Last Column command overwriting existing cell intermittently vba - vba

Question

Screenshot of what is happening here, for simplicity sake, I have changed the values to represent the columns that they rightfully belong in
I am working on a program where I need to copy and reorganize data from multiple worksheets into one master. One row per sheet. From columns G to R I will need to set up an if statement, so that if a value on the sheet is greater than 0 it will be copy/pasted to the next available column in it's row. For testing I have eliminated the if statement, so that I always get a result. The problem I am having is that on the first row of data the "B" column is being overwritten, subsequent rows work as expected. Any ideas as to why this could be happening?
Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim LastR As Long
Dim LastC As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Delete the sheet "Master" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Master").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'Add a worksheet with the name "Master"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Master"
'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
'Find the last row with data on the DestSh
With ActiveSheet
LastR = .Cells(.Rows.Count, "a").End(xlUp).Row
End With
With ActiveSheet
LastC = .Cells(LastR, .Columns.Count).End(xlToLeft).Column
End With
sh.Range("B2").Copy
DestSh.Cells(LastR + 1, "A").PasteSpecial xlPasteValues 'customer'
DestSh.Cells(LastR + 1, "B").Value = ("Glass") 'Product"
DestSh.Cells(LastR + 1, "C").Value = sh.Name 'Color Name
sh.Range("H32").Copy
DestSh.Cells(LastR + 1, "D").PasteSpecial xlPasteValues 'based on QTY'
DestSh.Cells(LastR + 1, "E").Value = ("Liters") 'based on Units'
DestSh.Cells(LastR + 1, "F").Value = ("Clear") 'Base'
sh.Range("F13").Copy
DestSh.Cells(LastR + 1, LastC + 1).PasteSpecial xlPasteValues 'THIS IS THE LINE GIVING ME TROUBLE'
End If
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Answer 1

Try to replace ActiveSheet with DestSh, probably this is the reason for the problem:
'Find the last row with data on the DestSh
With DestSh
LastR = .Cells(.Rows.Count, "a").End(xlUp).Row
End With
With DestSh
LastC = .Cells(LastR, .Columns.Count).End(xlToLeft).Column
End With
In your case, LastC = .Cells(LastR, .Columns.Count).End(xlToLeft).Column does not return the last column in the parent worksheet, but the last column in row LastR. Try this for the real last column:
LastC = LastRow(DestSh)
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
And this is worth reading - https://www.rondebruin.nl/win/s9/win005.htm