VBA .End (xlUP) not working

[andycreber]

HI

On the "Dump" tab, columns A, B, C, F & G ignore the last row of data being my header and paste it over the top and same happens with sheet "FL" data, that it pastes over the top over the top of the last row.


So it appears the .End(xlUp) does not work for sheets "AS" and "FL", any idea how to fix this?


Any help appreciated






Sub Macro2()


'AS SHEET




Dim Lr As Long




With Sheets("AS")
Lr = .Range("H:H").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("H4:H" & Lr).Copy
Sheets("Dump").Range("A5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With




With Sheets("AS")
Lr = .Range("I:I").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("I4:I" & Lr).Copy
Sheets("Dump").Range("B5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With

With Sheets("AS")
Lr = .Range("J:J").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("J4:J" & Lr).Copy
Sheets("Dump").Range("C5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With



With Sheets("AS")
Lr = .Range("M:M").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("M4:M" & Lr).Copy
Sheets("Dump").Range("F5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With




With Sheets("AS")
Lr = .Range("N:N").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("N4:N" & Lr).Copy
Sheets("Dump").Range("G5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With









'FL SHEET



With Sheets("FL")
Lr = .Range("H:H").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("H4:H" & Lr).Copy
Sheets("Dump").Range("A5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With





With Sheets("FL")
Lr = .Range("I:I").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("I4:I" & Lr).Copy
Sheets("Dump").Range("B5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False






End With

With Sheets("FL")
Lr = .Range("J:J").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("J4:J" & Lr).Copy
Sheets("Dump").Range("C5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With



With Sheets("FL")
Lr = .Range("M:M").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("M4:M" & Lr).Copy
Sheets("Dump").Range("F5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With




With Sheets("FL")
Lr = .Range("N:N").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("N4:N" & Lr).Copy
Sheets("Dump").Range("G5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With




Dim lRow As Integer
Dim intCol As Long
Dim rngCell As Range, fn


Set fn = Application.WorksheetFunction
Application.ScreenUpdating = False
For intCol = 2 To 3
For lRow = 353 To 2 Step -1
Set rngCell = Cells(lRow, intCol)
With rngCell
.Value = fn.Substitute(rngCell.Value, Chr(160), Chr(32))
.Value = Trim(rngCell.Value)
End With
If Len(rngCell) = 0 Then
rngCell.Delete shift:=xlUp
End If
Set rngCell = Nothing
Next lRow
Next intCol
Application.ScreenUpdating = True


Sheets("Dump").Select
Range("I11").Select
Selection.AutoFill Destination:=Range("I11:I206")


Range("D11").Select
Selection.AutoFill Destination:=Range("D11:D206")
Range("A1").Select
End Sub

 

[MARK858]

Please don't duplicate questions.
See my response here

 

[Fluff]

Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread.
Per forum rules, posts of a duplicate nature will be locked or deleted (rule 12 here: Forum Rules).