Problem With Selecting Last Row of data in a column containing Empty Cells

[Katterman]

Hello Everyone

I'm so close to resolving an issue that was started HERE.

I have worked the code and 3 of the 4 sections of code is working as desired
but one section of the copy and paste is not (The section below containing the Red Line) as this column
I'm copying will will contain Empty Cells and the code below will only work up
till that first empty cell is encountered. Not getting errors, just missing most of the data
in the row i'm copying from.

Here is my code:

Sub Copy_Data_3()


Dim ShName As String


ShName = ActiveSheet.Name
Application.ScreenUpdating = False
 
    Sheets("CleanIt").Select
    Range("C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets(ShName).Select
    Range("J2").Select
    Sheets(ShName).Paste
    
    Sheets("CleanIt").Select
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets(ShName).Select
    Range("M2").Select
    Sheets(ShName).Paste
    
[B]    Sheets("CleanIt").Select[/B]
[B]    Range("D2").Select[/B]
[B][COLOR=#ff0000]    Range(Selection, Selection.End(xlDown)).Select[/COLOR][/B]
[B]    Selection.Copy[/B]
[B]    Sheets(ShName).Select[/B]
[B]    Range("N2").Select[/B]
[B]    Sheets(ShName).Paste[/B]
    
    Sheets("CleanIt").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets(ShName).Select
    Range("AD2").Select
    Sheets(ShName).Paste
   
    Range("A1").Select


 Application.ScreenUpdating = True
 Application.CutCopyMode = False


End Sub

The Section Above containing the line in RED is where the problem is and where I'm pretty sure the issue is.
(Still a VBA Newbie here ) .
If this helps at all, the other 3 columns never have empty cells and always end on the same Last Row therefore the Last Row value can be used as the last row value for the problem Column that is not capturing all data needed there..

I do not want to remove the Blanks but I do need to capture and paste the full column empty cells and all.

Thanks in Advance for you help.

Scott

 

[Norie]

Try using coming from the bottom up using xlUp.

Sub Copy_Data_3()

    Application.ScreenUpdating = False

    With Sheets("CleanIt")
        .Range("C2", .Range("C" & Rows.Count).End(xlUp)).Copy ActiveSheet.Range("J2")
        .Range("B2", .Range("B" & Rows.Count).End(xlUp)).Copy ActiveSheet.Range("M2")
        .Range("D2", .Range("D" & Rows.Count).End(xlUp)).Copy ActiveSheet.Range("N2")
        .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Copy ActiveSheet.Range("AD2")
    End With

    Application.ScreenUpdating = True
    Application.CutCopyMode = False

End Sub

 

[Katterman]

WOW !!!

This is Exactly what i needed and works Perfectly.
and best of call so clean and simple

Thank You So Much Norie
This is very Much Appreciated.

Scott