VBA Code to copy specific rows from one sheet to another, based on cell value

[Woozypictures]

Hi All,

I've been using this fantastic forum for previous VBA issues I've had, seeing other peoples posts and using the brilliant answers people have provided, however It seems Im going to need the extra help on this one!

I have a workbook that I use as a report for Aged Debtors, with a query that pulls data from our ERP system on a daily basis. The idea is that this VBA code is activated by a button on a sheet called "DATA". Once clicked it scans the query worksheet "Debtors", and if any cells in column P are blank, to copy columns (B,C,E) from this sheet into another sheet called "IGNORE"'. Issue is the code I've written pulls the whole row, not the specific columns. This is the code I have currently:
--------------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
A = Worksheets("Debtors").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To A

If Worksheets("Debtors").Cells(i, 16).Value = "" Then

Worksheets("Debtors").Rows(i).Copy
Worksheets("IGNORE").Activate
B = Worksheets("IGNORE").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("IGNORE").Cells(B + 1, 1).Select
ActiveSheet.Paste
Worksheets("Debtors").Activate

End If
Next

Application.CutCopyMode = False

End Sub
--------------------------------------------------------------------------------------

So just to clarify:

1. I have a button on a worksheet called "DATA".
2. When you click it, the macro scans a worksheet called "Debtors" column P, and anything blank it picks up the whole row and copy/pastes it to a worksheet called "IGNORE".
3. I need it to copy paste specific columns (B,C and E) to the worksheet "IGNORE" whilst keeping the rest of the rules set (i.e next blank cell etc, dont delete dont overwrite)

I really hope someone on here knows how to fix this, maybe its an easy fix or maybe its not possible but I really appreciate any support!

 

[JoeMo]

You want the copied cells from "Debtors" to be pasted to the same columns (B,C,E) in IGNORE or just columns A:C in IGNORE?

 

[Woozypictures]

You want the copied cells from "Debtors" to be pasted to the same columns (B,C,E) in IGNORE or just columns A:C in IGNORE?

Hi JoeMo,

Apologies I should have clarified that! I'd like the copied cells from "Debtors" to go into "IGNORE" Columns A B and C

Thank you!

 

[JoeMo]

Untested. Try this on a copy of your worksheet:

Private Sub CommandButton1_Click()
A = Worksheets("Debtors").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To A
    If Worksheets("Debtors").Cells(i, 16).Value = "" Then
        Intersect(Worksheets("Debtors").Rows(i), _
        Worksheets("Debtors").Range("B:B,C:C,E:E")).Copy _
        Destination:=Worksheets("IGNORE").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    End If
Next i
Application.CutCopyMode = False
End Sub

 

[Woozypictures]

Untested. Try this on a copy of your worksheet:

Private Sub CommandButton1_Click()
A = Worksheets("Debtors").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To A
    If Worksheets("Debtors").Cells(i, 16).Value = "" Then
        Intersect(Worksheets("Debtors").Rows(i), _
        Worksheets("Debtors").Range("B:B,C:C,E:E")).Copy _
        Destination:=Worksheets("IGNORE").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    End If
Next i
Application.CutCopyMode = False
End Sub

It Works!! Thank you so much JoeMo I really really appreciate your support on this :D

 

[JoeMo]

It Works!! Thank you so much JoeMo I really really appreciate your support on this :D

You are welcome - thanks for the reply.

 

[Woozypictures]

You are welcome - thanks for the reply.

Hi Joe,

Thank you for the help on the VBA! Its been working perfectly, however I've noticed that when others are using the sheet, they'll click the button multiple times and the code does not avoid duplicates, thus we are having multiples of the same data being pulled over. I've added a check before the button goes ahead, but I wanted to know if there was a way to remove duplicates if someone tries to use the button twice and click yes both times. Here is the current code:
--------------------------------------------------------------------------------------------------
Private Sub CommandButton1_Click()

Dim answer As Integer

answer = MsgBox("Do You Want To Update Commentary?", vbQuestion + vbYesNo + vbDefaultButton2, "Data Check")

If answer = vbYes Then

A = Worksheets("Debtors").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To A
If Worksheets("Debtors").Cells(i, 16).Value = "" Then
Intersect(Worksheets("Debtors").Rows(i), _
Worksheets("Debtors").Range("B:B,C:C,E:E")).Copy _
Destination:=Worksheets("Commentary").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next i
Application.CutCopyMode = False

Else
End If

End Sub
--------------------------------------------------------------------------------------------------

I wanted to know if there was something that could be added within this code so after its copied and pasted the rows across, it checks for duplicates and removes them. Or if it can check for duplicates before copy/paste that would be good too!

Kind Regards
Mahesh