VBA將工作表的某些列復制並粘貼到另一張工作表上的特定列

Question

所以，我有兩張表，“預算設置”和“摘要”。 我需要使用 VBA 根據一個標准將預算設置的某些列（不是整行）復制並粘貼到匯總表的特定列。

這是預算設置表的樣子：

這就是我的摘要表現在的樣子（在運行我編寫的 VBA 代碼之后）：

所以，如果預算設置表A欄的值為“是”，我想把預算設置B欄的值轉移到匯總A欄，預算設置C欄到匯總B欄，預算F欄設置到匯總的 C 列，將預算設置的 G 列設置到匯總的 H 列。

這段代碼可以解決問題：

Sub PCAMMatching()

a = Worksheets("Budget Setup").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

    If Worksheets("Budget Setup").Cells(i, 1).Value = "Yes" Then

        Worksheets("Budget Setup").Cells(i, 2).Copy
        Worksheets("Summary").Cells(i, 1).Select
        ActiveSheet.Paste

    End If

    If Worksheets("Budget Setup").Cells(i, 1).Value = "Yes" Then

        Worksheets("Budget Setup").Cells(i, 3).Copy
        Worksheets("Summary").Cells(i, 2).Select
        ActiveSheet.Paste
    End If

    If Worksheets("Budget Setup").Cells(i, 1).Value = "Yes" Then

        Worksheets("Budget Setup").Cells(i, 6).Copy
        Worksheets("Summary").Cells(i, 3).Select
        ActiveSheet.Paste
    End If

    If Worksheets("Budget Setup").Cells(i, 1).Value = "Yes" Then

        Worksheets("Budget Setup").Cells(i, 7).Copy
        Worksheets("Summary").Cells(i, 8).Select
        ActiveSheet.Paste
    End If

Next

Application.CutCopyMode = False


End Sub

但是，正如您在我的摘要表中看到的那樣，此代碼正在創建 3 個空白行，因為“預算設置”表上的前 3 行在 A 列中的狀態為“否”。我真正想要的是，如果狀態為“否”，只需跳過該行（而不是創建一個空白行）並將狀態為“是”的行一一復制到匯總表中。

因此，理想情況下，我希望我的摘要表如下所示：

任何幫助，將不勝感激！

Answer 1

這是使用AutoFilter和SpecialCells(xlCellTypeVisible)的基本 copy_paste

'Assign and set your variables
Dim ws1 As Worksheet, ws2 As Worksheet, lRow As Long

Set ws1 = ThisWorkbook.Sheets("Budget Setup")
Set ws2 = ThisWorkbook.Sheets("Summary")

lRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row

    With ws1
        .Range("A1").AutoFilter Field:=1, Criteria1:="Yes" 'set your filter

        'copy the visible cells in each column from row 2 and resize to the last row
        'paste to the the cell you want your copied range to start in your second worksheet
        .Range("C2").Resize(lRow - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("B2")
        .Range("F2").Resize(lRow - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("C2")
        .Range("H2").Resize(lRow - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("H2")

        .Range("A1").AutoFilter 'clear the filter
    End With