Copy certain excel columns based on ones criteria

Question

First thing I did was create a button that would copy certain cells using this code:

Worksheets("Sheet1").Range("A:A,B:B,D:D").Copy _ and it worked fine.

Second, I found the code that would copy all details in a row based on the criteria of one, in this case if there was an "A" in the "Location" column.

Private Sub ENTIREROW_Click() 'Sub copyrows()

Dim i As Range, Cell As Object

Set i = Range("D:D") 'Substitute with the range which includes your True/False values

For Each Cell In i

   If IsEmpty(Cell) Then
       Exit Sub
   End If

   If Cell.Value = "A" Then
       Cell.ENTIREROW.Copy
       Sheet2.Select 'Substitute with your sheet
       ActiveSheet.Range("A65536").End(xlUp).Select
       Selection.Offset(1, 0).Select
       ActiveSheet.Paste
   End If

Next

End Sub

My question is, how do I copy all information in the specified columns (A,B,D) where there is an "A" in "Location" in one button.

Furthermore, this is my example data, the sheet I will actually use this on has 34 columns to copy. Is there a more efficient way of setting a range when you don't want an entire sequence, everything but the data in column C?

Thanks in advance and apologies for my explanation skills.

Answer 1

One way maybe to:

• filter your source
• hide column C
• copy the result using .PasteSpecial xlPasteValues into the destination
• Unhide column C on the source sheet
• remove the autofilter

Using xlPasteValues only pastes the visible cells from the source - so no column C

The code then looks like this: .

Sub CopyRows()
    With Sheets(1).Range([A2], [A2].SpecialCells(xlLastCell))
        [A1].AutoFilter
        .AutoFilter Field:=4, Criteria1:="A"
        [C:C].EntireColumn.Hidden = True
        .Copy
        [C:C].EntireColumn.Hidden = False
    End With
    With Sheets(2)
        If .Cells(Sheets(2).Rows.Count, 1).End(xlUp) = "" Then 'it's a clean sheet
            .Cells(Sheets(2).Rows.Count, 1).End(xlUp).PasteSpecial Paste:=xlPasteValues
        Else
            .Cells(Sheets(2).Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
        End If
    End With
    Application.CutCopyMode = False
    Sheet1.[A1].AutoFilter
End Sub