宏复制到另一张纸上的下一个空白行

Question

我正在使用此宏将一张纸复制到另一张纸上，但每次运行宏时它都会覆盖数据。有什么方法可以更改宏，以便它粘贴的任何数据在下一个空白行中？

谢谢:)

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 

末次

Answer 1

每个j=1之前添加

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

，并更改j = 1到j = lastrow