Macro to copy to next blank row on another sheet

问题

I'm using this macro to copy from one sheet to another based on text in one cell, but it overwrites the data every time I run the macro. Is there any way to change the macro so that any data it pastes is in the next blank row?

Thanks :)

Sub CopyYes()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet

' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Main Data")
Set Target = ActiveWorkbook.Worksheets("Cheque Data")

j = 1     ' Start copying to row 1 in target sheet
For Each c In Source.Range("A1:A1000")   ' Do 1000 rows
    If c = "Cheque" Then
       Source.Rows(c.Row).Copy Target.Rows(j).End(xlUp).Offset(1)
       j = j + 1
    End If
Next c

    ' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Main Data")
Set Target = ActiveWorkbook.Worksheets("Gift Card Data")

j = 1     ' Start copying to row 1 in target sheet
For Each c In Source.Range("A1:A1000")   ' Do 1000 rows
    If c = "Gift Card" Then
       Source.Rows(c.Row).Copy Target.Rows(j).End(xlUp).Offset(1)
       j = j + 1
    End If
Next c

    ' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Main Data")
Set Target = ActiveWorkbook.Worksheets("Promo Code Data")

j = 1     ' Start copying to row 1 in target sheet
For Each c In Source.Range("A1:A1000")   ' Do 1000 rows
    If c = "Promo Code" Then
       Source.Rows(c.Row).Copy Target.Rows(j).End(xlUp).Offset(1)
       j = j + 1
    End If
Next c

Sheets("Main Data").Range("A2:F200").ClearContents
Sheets("Main Data").Range("J2:Q200").ClearContents

End Sub

回答1:

Before each j=1 add

lastrow = Target.Range("A65000").End(xlUp).Row + 1

And change j = 1 to j = lastrow

来源：https://stackoverflow.com/questions/36768911/macro-to-copy-to-next-blank-row-on-another-sheet