After deleting entire rows, newly copied data is shifted down x rows - excel

Question

Before I copy a new set of data into a set of columns I want to delete everything but the headers, which I do using the following code:
wsS.Rows("4:1048560").EntireRow.Delete
I do it like this because the data spreads over column A to AZ and it's not the same rows lenght.
But somehow, the comand leaves cells that contained data previously and are now empty selected, but only for columns A to F (I have 9 blocks of data that are copied and for each block I used a different sub() that are later called within a button). I also apply a filter before on the sheet where I copy the data from.
My problem is that the new copy somehow starts where the other data should have ended. The more ofther I run the code, the more rows down the copy will start. The code for copying was suggested by someone here and I only adapted it slightly to my needs.
The weird thing is that if I run the delete command above in the Immediate Window (or I do a manual delete) and then I run the full code again, the copied data will start as it should in cell A4.
I have also tried to do a select on cell A4 after I delete and then copy the new data. Still no success. And this happens only on the first set of data I copy (columns A to F) -> I used the same code to copy more ranges (A to F, H to M, O to T and so on)
This is the code for one block, namely A to F:
Private Sub CopyDataAtoF()
Dim wsR As Worksheet: Set wsR = ThisWorkbook.Worksheets("Data Raw")
Dim wsS As Worksheet: Set wsS = ThisWorkbook.Worksheets("Scatter Raw")
Dim lrR As Long: lrR = wsR.Cells(wsR.Rows.count, "A").End(xlUp).Row
Dim lrS1 As Long: lrS1 = wsS.Cells(wsS.Rows.count, "A").End(xlUp).Row + 1
Dim lrS2 As Long: lrS2 = wsS.Cells(wsS.Rows.count, "C").End(xlUp).Row + 1
Dim lrS3 As Long: lrS3 = wsS.Cells(wsS.Rows.count, "E").End(xlUp).Row + 1
With wsR
Dim fRng As Range: Set fRng = .Range(.Cells(1, "A"), .Cells(lrR, "AN"))
Dim rngN As Range: Set rngN = .Range(.Cells(2, "N"), .Cells(lrR, "N"))
Dim rngY As Range: Set rngY = .Range(.Cells(2, "Y"), .Cells(lrR, "Y"))
Dim cRng As Range: Set cRng = Union(rngN, rngY)
End With
Application.ScreenUpdating = False
wsS.Rows("4:1048560").EntireRow.Delete Shift:=xlUp
fRng.AutoFilter field:=25, Criteria1:="<>", Operator:=xlFilterValues
fRng.AutoFilter field:=1, Criteria1:="criteria1", Operator:=xlFilterValues
If fRng.SpecialCells(xlCellTypeVisible).CountLarge > 2 Then
cRng.Copy
wsS.Cells(lrS1, "A").PasteSpecial xlPasteValues
With wsS
Dim vis1 As Long: vis1 = .Cells(.Rows.count, "A").End(xlUp).Row
Dim lcS1 As Long: lcS1 = .Cells(lrS1, "A").End(xlToRight).Column + 1
Dim divA As Range: Set divA = .Range(.Cells(lrS1, "A"), .Cells(vis1, "A"))
Dim divY1 As Range: Set divY1 = .Range(.Cells(lrS1, lcS1), .Cells(vis1, lcS1))
divY1.Formula = "=" & .Cells(lrS1, 1).Address(RowAbsolute:=False) & " / 1000"
divA.Value2 = divY1.Value2
divY1.ClearContents
End With
End If
fRng.AutoFilter field:=1, Criteria1:="criteria2", Operator:=xlFilterValues
If fRng.SpecialCells(xlCellTypeVisible).CountLarge > 2 Then
cRng.Copy
wsS.Cells(lrS2, "C").PasteSpecial xlPasteValues
With wsS
Dim vis2 As Long: vis2 = .Cells(.Rows.count, "C").End(xlUp).Row
Dim lcS2 As Long: lcS2 = .Cells(lrS2, "C").End(xlToRight).Column + 1
Dim divC As Range: Set divC = .Range(.Cells(lrS2, "C"), .Cells(vis2, "C"))
Dim divY2 As Range: Set divY2 = .Range(.Cells(lrS2, lcS2), .Cells(vis2, lcS2))
divY2.Formula = "=" & .Cells(lrS2, 3).Address(RowAbsolute:=False) & " / 1000"
divC.Value2 = divY2.Value2
divY2.ClearContents
End With
End If
fRng.AutoFilter field:=1, Criteria1:="criteria3", Operator:=xlFilterValues
If fRng.SpecialCells(xlCellTypeVisible).CountLarge > 2 Then
cRng.Copy
wsS.Cells(lrS3, "E").PasteSpecial xlPasteValues
With wsS
Dim vis3 As Long: vis3 = .Cells(.Rows.count, "E").End(xlUp).Row
Dim lcS3 As Long: lcS3 = .Cells(lrS3, "E").End(xlToRight).Column + 1
Dim divE As Range: Set divE = .Range(.Cells(lrS3, "E"), .Cells(vis3, "E"))
Dim divY3 As Range: Set divY3 = .Range(.Cells(lrS3, lcS3), .Cells(vis3, lcS3))
divY3.Formula = "=" & .Cells(lrS3, 5).Address(RowAbsolute:=False) & " / 1000"
divE.Value2 = divY3.Value2
divY3.ClearContents
End With
End If
wsS.Range("A1").Select
wsR.AutoFilter.ShowAllData
Application.ScreenUpdating = True
End Sub

Answer 1

The issue you are experiencing, is due to the fact that all variable prefixed with lr are storing the index number (invariably) of last row that contained data, before you all delete them.
Based on how the code is written, when you paste new data, it starts from the index number stored in the lr-s.
The solution is to recalculate the value of the lr-s after deleting the data.
Replace the top of your code with the modified codes below, and the codes should work as your expect.
Private Sub CopyDataAtoF()
Dim wsR As Worksheet: Set wsR = ThisWorkbook.Worksheets("Data Raw")
Dim wsS As Worksheet: Set wsS = ThisWorkbook.Worksheets("Scatter Raw")
Application.ScreenUpdating = False
wsS.Rows("4:1048560").EntireRow.Delete Shift:=xlUp
Dim lrR As Long: lrR = wsR.Cells(wsR.Rows.count, "A").End(xlUp).Row
Dim lrS1 As Long: lrS1 = wsS.Cells(wsS.Rows.count, "A").End(xlUp).Row + 1
Dim lrS2 As Long: lrS2 = wsS.Cells(wsS.Rows.count, "C").End(xlUp).Row + 1
Dim lrS3 As Long: lrS3 = wsS.Cells(wsS.Rows.count, "E").End(xlUp).Row + 1
With wsR
Dim fRng As Range: Set fRng = .Range(.Cells(1, "A"), .Cells(lrR, "AN"))
Dim rngN As Range: Set rngN = .Range(.Cells(2, "N"), .Cells(lrR, "N"))
Dim rngY As Range: Set rngY = .Range(.Cells(2, "Y"), .Cells(lrR, "Y"))
Dim cRng As Range: Set cRng = Union(rngN, rngY)
End With
fRng.AutoFilter field:=25, Criteria1:="<>", Operator:=xlFilterValues
fRng.AutoFilter field:=1, Criteria1:="criteria1", Operator:=xlFilterValues
If fRng.SpecialCells(xlCellTypeVisible).CountLarge > 2 Then
The change I made in the code was to move;
Application.ScreenUpdating = False
wsS.Rows("4:1048560").EntireRow.Delete Shift:=xlUp
above;
Dim lrR As Long: lrR = wsR.Cells(wsR.Rows.count, "A").End(xlUp).Row
Dim lrS1 As Long: lrS1 = wsS.Cells(wsS.Rows.count, "A").End(xlUp).Row + 1
... ...
i.e. After deleting the necessary rows, the lr-s are then defined and calculated.
Thank you.