VBA 将 sheet 的某些列复制并粘贴到另一个 sheet 的特定列

VBA Copy and Paste Certain Columns of a sheet to specific columns on another sheet

所以,我有两个 sheet,“预算设置”和“摘要”。我需要根据一个标准使用 VBA 将预算设置的某些列(不是整行)复制并粘贴到摘要 sheet 的特定列。

预算设置 sheet 如下所示:

这就是我的摘要 sheet 目前的样子(在 运行 我写的 VBA 代码之后):

因此,如果预算设置的 A 列中的值为“是”sheet,我想将预算设置的 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

但是,正如您在我的摘要 sheet 中看到的那样,此代码创建了 3 个空白行,因为预算设置 sheet 的前 3 行在列中的状态为“否” A. 我真正想要的是,如果状态为“否”,只需跳过该行(而不是创建一个空白行)并将状态为“是”的行逐一复制到摘要 sheet .

所以,理想情况下,我希望我的摘要 sheet 看起来像这样:

如有任何帮助,我们将不胜感激!

这是使用 AutoFilterSpecialCells(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