copy all rows based on a cell value

[ajaf123]

Hello. I have a sheet with certain used rows with gaps in between. I want a macro that goes through column L and if it finds a cell that is used copy that entire row and paste it on a sheet named Compiled data. I started with a macro but it only copies the first unused row. I want the macro to copy and paste all rows where Column L is not blank. Kindly help.

 

[ajaf123]

I have come up with following macro, but it only selects first row in which L is not empty.

Dim i As Integer
For i = 200 To 6 Step -1
If Cells(i, 12) <> "" Then Rows(i).Select
Next i
Selection.Copy

 

[vcoolio]

Hello Ajaf,

This may help:-

Sub MoveIt()

Application.ScreenUpdating = False
Sheets("Sheet2").Range("A2:O" & Rows.Count).ClearContents
With ActiveSheet
    .AutoFilterMode = False
With Range("L2", Range("L" & Rows.Count).End(xlUp))
        .AutoFilter 1, "*"
        .Offset(0).EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    End With
    .AutoFilterMode = False
End With

Application.ScreenUpdating = True
Sheets("Sheet2").Select

End Sub

Attached is my test work book for you to peruse. All rows associated with non blank cells in Column L are transferred to sheet 2. You will have to change the sheet references in the code to suit yourself.

https://www.dropbox.com/s/cow4ng08ik3cljb/Ajaf123.xlsm?dl=0

I hope it helps.

Cheerio,
vcoolio.

 

[ajaf123]

Hello vcoolio. The code is not pasting data to sheet 2. it just activates sheet 2 without pasting the data. I think the paste command is missing from your code.

Hello Ajaf,

This may help:-

Sub MoveIt()

Application.ScreenUpdating = False
Sheets("Sheet2").Range("A2:O" & Rows.Count).ClearContents
With ActiveSheet
    .AutoFilterMode = False
With Range("L2", Range("L" & Rows.Count).End(xlUp))
        .AutoFilter 1, "*"
        .Offset(0).EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    End With
    .AutoFilterMode = False
End With

Application.ScreenUpdating = True
Sheets("Sheet2").Select

End Sub

Attached is my test work book for you to peruse. All rows associated with non blank cells in Column L are transferred to sheet 2. You will have to change the sheet references in the code to suit yourself.

https://www.dropbox.com/s/cow4ng08ik3cljb/Ajaf123.xlsm?dl=0

I hope it helps.

Cheerio,
vcoolio.

 

[vcoolio]

Hello Ajaf,

No. The code is doing exactly as you asked. If you look at the test work book you'll see that on sheet 1 there are four rows that will be transferred to sheet 2 as these are the ones that don't have blanks in Column L. Activate the macro and you'll see four rows of data transferred to sheet 2. This line of code:-

.Offset(0).EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)

does the copying/pasting.

Cheerio,
vcoolio.

 

[vcoolio]

........or you could just use your own code amended as follows:-

Sub Copy()

    Dim i As Integer
    
For i = 200 To 6 Step -1
    If Cells(i, 12) <> "" Then
    Rows(i).Copy Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    End If
Next i

 Sheets("Sheet2").Select
 
End Sub

..............and in Post #3, did you change the range in this line of code:-

With Range("L2", Range("L" & Rows.Count).End(xlUp))

to suit your scenario?

(L6 perhaps?)


Cheerio,
vcoolio.

 

[ajaf123]

hey. thankyou for your response. Just one last issue. The macro does not work when column L has number in it. It works perfectly with alphabets.

Hello vcoolio. The code is not pasting data to sheet 2. it just activates sheet 2 without pasting the data. I think the paste command is missing from your code.

 

[ajaf123]

yes i changed the ranges according to my sheet

 

[vcoolio]

Sorry Ajaf. This minor amendment should do it for you:-

Sub MoveIt()

Application.ScreenUpdating = False
Sheets("Sheet2").Range("A2:O" & Rows.Count).ClearContents
With ActiveSheet
    .AutoFilterMode = False
With Range("L2", Range("L" & Rows.Count).End(xlUp))
        .AutoFilter 1, "<>"
        .Offset(0).EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
        '.Offset(1).EntireRow.Delete
    End With
    .AutoFilterMode = False
End With

Application.ScreenUpdating = True
Sheets("Sheet2").Select

End Sub

https://www.dropbox.com/s/cow4ng08ik3cljb/Ajaf123.xlsm?dl=0

BTW, your code, as amended in my post #6, should work also.

Cheerio,
vcoolio.

 

[ajaf123]

thanks alot. it worked.

Sorry Ajaf. This minor amendment should do it for you:-

Sub MoveIt()

Application.ScreenUpdating = False
Sheets("Sheet2").Range("A2:O" & Rows.Count).ClearContents
With ActiveSheet
    .AutoFilterMode = False
With Range("L2", Range("L" & Rows.Count).End(xlUp))
        .AutoFilter 1, "<>"
        .Offset(0).EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
        '.Offset(1).EntireRow.Delete
    End With
    .AutoFilterMode = False
End With

Application.ScreenUpdating = True
Sheets("Sheet2").Select

End Sub

https://www.dropbox.com/s/cow4ng08ik3cljb/Ajaf123.xlsm?dl=0

BTW, your code, as amended in my post #6, should work also.

Cheerio,
vcoolio.