VBA将工作表中的某些列复制并粘贴到另一工作表中的特定列

Question

因此，我有两张纸，“预算设置”和“摘要”。我需要基于一个条件，使用VBA将“预算设置”的CERTAIN列（不是整行）复制并粘贴到“摘要”表的特定列中。

“预算设置”工作表如下所示：

这是我的“摘要”表现在的样子（运行我编写的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