Excel VBA: Copy cells from multiple sheets to a si

Question

I am pretty new to VBA and am trying to automate a process at work where I need to extract select cells from an array of 6 sheets and consolidate them in another sheet. The code I have works, but is kinda "clunky" - I am using the excel copy and paste functions, but can't seem to find a good solution away from the copy-and-paste function. And when I try to add a paste special function, I get an 1004 error. Would love advice on optimising this!

For each sheet to be copied, cells are marked in the first column with "1", "0" or left blank - if the cells are "1" or "0", I copy the other cells in the row to the consolidated sheet. There are some gaps in between rows, so I opted to use a For-Loop instead of a Do-While statement.

I've attached the code as follows:

Sub TEST()
    Dim i As Integer 'copying row counter for each sheet to be copied
    Dim j As Integer 'pasting row counter in consolidated sheet
    Dim cal(1 To 6) As String  'copied sheetname
          cal(1) = "Picks"
          cal(2) = "Eats"
          cal(3) = "Night Out"
          cal(4) = "Active"
          cal(5) = "Family"
          cal(6) = "Arts"
    Dim x As Integer

    Dim y As Integer 'column for date
    Dim z As Integer 'max row to run till

    y = 1 'column checked in each sheet where condition for copying is met
    z = 300 'number of rows to check in each sheet

    j = 1

    For x = 1 To 6

    For i = 1 To z
        If Sheets(cal(x)).Cells(i, y) = "0" Or Sheets(cal(x)).Cells(i, y) = "1" Then
            Sheets(cal(x)).Select
            Range(Sheets(cal(x)).Cells(i, 2), Sheets(cal(x)).Cells(i, 10)).Select
            Selection.Copy
            Application.Goto ActiveWorkbook.Sheets(Consolidated).Cells(j, 1)
            ActiveSheet.Paste
    Else
        j = j - 1
        End If
        j = j + 1
    Next i
    Next x
End Sub

Again I would love to optimise this code, using another method instead of copy-and-paste. Also I tried:

Application.Goto ActiveWorkbook.Sheets(Consolidated).Cells(j, 1)
ActiveSheet.PasteSpecial Operation:=xlPasteValues

Which resulted in a 1004 error. Would love to know what went wrong.

Answer 1

You're getting the error because you're attempting to paste into the activesheet instead of into a range on the activesheet, and because you have the wrong argument for the PasteSpecial method.

This will work, although it's not what you want to do: (see CopyWithoutClipboard further below for a better alternative)

Sub PasteIntoGoto()
    Sheets("sheet1").Range("A1").Copy
    Application.Goto ActiveWorkbook.Sheets("Sheet3").Cells(1, 1)
    ActiveSheet.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
End Sub

Note the range inserted in between ActiveSheet and PasteSpecial and Paste:= instead of Operation:=.

You're right in wanting to optimize your code. Maybe the most important guideline in Excel VBA development is to never select anything, which can cause all kinds of problems. In your first example, you are using .Select explicitly, and in the second example, .GoTo is effectively doing the same thing.

Rather than selecting a sheet, copying a range, selecting another sheet, and pasting into another range, you can write a copy of the data to the target range (either on the same sheet or on another one) like this:

Sub CopyWithoutClipboard()
    Sheets("sheet1").Range("A1").Copy Sheets("sheet2").Range("A1")
End Sub

Obviously you can use variables in place of the hard-coded objects in the snippet above.