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

Question

So, I have two sheets, “Budget Setup” and “Summary”. I need to use VBA to copy and paste CERTAIN columns (NOT entire row) of the Budget Setup to specific columns of the Summary sheet, based on one criterion.

This is how the Budget Setup sheet looks like:

And this is how my Summary sheet looks like for now (after running the VBA code I wrote):

So, if the value is “Yes” in Column A of Budget Setup sheet, I want to transfer the value in Column B of Budget Setup to Column A of Summary, Column C of Budget Setup to Column B of Summary, Column F of Budget Setup to Column C of Summary, and Column G of Budget Setup to Column H of Summary.

This code will do the trick:

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

However, as you can see on my Summary sheet, this code is creating 3 blank rows because the top 3 rows on the Budget Setup sheet have a status of “No” in Column A. What I really want is, if the status is “No”, simply skip that row (instead of creating a blank row) and copy the rows with a status of “Yes” one by one to the Summary sheet.

So, ideally, I want my Summary sheet to look like this:

Any help would be appreciated!

Answer 1

Here is a basic copy_paste using AutoFilter and SpecialCells(xlCellTypeVisible)

'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