Question

我正在尝试将某些行从一个工作簿复制到另一个工作簿中。但是，它不会在新工作簿的现有行下添加新行。

源工作簿有10个工作表，每个工作表中都有不同的详细信息，但是每张工作表的设置方式相同，即列标题相同。每个工作表都有其自己的按钮，该按钮将“是”行复制到相同的目标工作簿中，所有行都结束于同一工作表上。 L列是“是/否”列。我只能将yes行复制到目标工作簿中，但是将它们粘贴在最上面的行上，该行将覆盖已经存在的行。在源工作表上，我需要从第14行复制并粘贴到目标工作表的第6行。对我的代码的任何帮助将不胜感激。

Private Sub CommandButton2_Click()
    Dim i As Long
    Dim outRow As Long
    Dim sourceWs As Worksheet, destWs As Worksheet

    Set sourceWs = Workbooks("SrcTest.xlsm").Worksheets("SRU 1")
    Set destWs = Workbooks.Open("DestTest.xlsx").Worksheets("All Data")

    outRow = 6

    For i = 14 To 200
        If sourceWs.Cells(i, 12).Value = "Yes" Then
            sourceWs.Rows(i).EntireRow.Copy
            destWs.Rows(outRow).PasteSpecial (xlPasteValues)
            outRow = outRow + 1                 ' not adding new rows under existing rows
            Application.CutCopyMode = False
        End If
    Next i 
End Sub

预期结果是每次单击按钮时，L列中所有带有“是”的行都将复制到目标工作簿中任何现有行下。无论我使用哪个原始工作表（1到10），都需要发生这种情况。

Answer 1

您可以仅使用"Yes"标准过滤数据并复制粘贴，而不必像遍历每一行那样（很费时间）：

Option Explicit
Private Sub CommandButton2_Click()
    Dim i As Long
    Dim outRow As Long
    Dim Col As Integer
    Dim sourceWs As Worksheet, destWs As Worksheet

    Set sourceWs = Workbooks("SrcTest.xlsm").Worksheets("SRU 1")
    Set destWs = Workbooks.Open("DestTest.xlsx").Worksheets("All Data")

    outRow = destWs.Cells(destWs.Rows.Count, 1).End(xlUp).Row + 1 'next available row on destination workbook

    With sourceWs
        i = .Cells(.Rows.Count, 1).End(xlUp).Row 'last used row on the sheet
        .Rows(13).AutoFilter Field:=12, Criteria1:="Yes" 'no need to loop, just filter the sheet with your criteria
        .Range("A2", .Cells(i, "M")).SpecialCells(xlCellTypeVisible).Copy 'copy the visible rows
        .AutoFilterMode = False
    End With
    destWs.Cells(outRow, 1).PasteSpecial xlPasteValues
    destWs.Cells(outRow, 1).PasteSpecial xlPasteFormats

End Sub

我的代码假定您在两张纸的A列中都有数据。

未在新工作簿的现有行下添加新行

1 个答案: