要复制到另一个工作表上的下一个空白行的宏

时间:2016-04-21 11:58:02

标签: excel-vba vba excel

我正在使用此宏根据一个单元格中的文本从一个工作表复制到另一个工作表,但每次运行宏时它都会覆盖数据。有没有办法更改宏,以便它粘贴的任何数据都在下一个空白行?

谢谢:)

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 个答案:

答案 0 :(得分:2)

在每次j=1添加

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

j = 1更改为j = lastrow