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

Posted 2023-02-24

【中文标题】宏复制到另一张纸上的下一个空白行

【英文标题】：Macro to copy to next blank row on another sheet

【发布时间】：2016-04-21 11:58:01

【问题描述】：

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

谢谢:)

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

结束子

【参考方案1】：

在每个j=1之前添加

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

并将j = 1 更改为j = lastrow