0

I am trying to copy columns f:g from each tab in a file (wb). Each tab has a different amount of rows so I also need to include a ctrl+shift+down when selecting the range. When pasting into my current file (ws) I also need to consider an offset because I am pasting 2 columns each time (next to each other).

I tried the following code but I keep getting a Run time error (object doesn't support this property), what am I missing?

    For i = 1 To wb.Sheets.Count
        wb.Range("f2:G2").End(xlDown).Select.Copy
        start.Offset(i + 2, 2).PasteSpecial xlPasteValues
    Next i
VBasic2008
  • 44,888
  • 5
  • 17
  • 28
  • See this & give it a vote: https://stackoverflow.com/q/50776026/4961700 – Solar Mike Aug 16 '22 at 05:51
  • You say: *I tried the following code but I keep getting an error, what am I missing?* You are missing the fact that nobody here can see your screen and the error message. Please edit your question and add the exact error message. – Tom Brunberg Aug 16 '22 at 06:18

1 Answers1

0

Copy Values From All Worksheets

Sub Test()
    
    ' Before your code...
    
    Const sFirstRowAddress As String = "F2:G2"
    
    ' First part of your code...
    
    Dim wb As Workbook ' Set wb = ?
    Dim Start As Range ' Set Start = ?
    
    ' New code...
    
    ' Using the first source worksheet, calculate the total number of rows
    ' ('trCount') and the number of columns ('cCount').
    Dim trCount As Long
    Dim cCount As Long
    
    With wb.Worksheets(1).Range(sFirstRowAddress)
        trCount = .Worksheet.Rows.Count - .Row + 1
        cCount = .Columns.Count
    End With
    
    ' Reference the first destination row ('drrg').
    Dim drrg As Range: Set drrg = Start.Cells(1).Resize(, cCount)
    
    Dim sws As Worksheet
    Dim srg As Range
    Dim slCell As Range
    Dim drg As Range
    Dim rCount As Long
    
    For Each sws In wb.Worksheets
        ' Turn off AutoFilter.
        If sws.AutoFilterMode Then sws.AutoFilterMode = False
        ' Reference the first source row...
        With sws.Range(sFirstRowAddress)
            ' Attempt to reference the last non-empty cell ('slCell').
            Set slCell = .Resize(trCount) _
                .Find("*", , xlFormulas, , xlByRows, xlPrevious)
            If Not slCell Is Nothing Then ' a non-empty cell was found
                rCount = slCell.Row - .Row + 1
                Set srg = .Resize(rCount)
                Set drg = drrg.Resize(rCount)
                drg.Value = srg.Value ' copy values
                Set drrg = drrg.Offset(rCount) ' next first destination row
            'Else ' all source cells are empty; do nothing
            End If
        End With
    Next sws
    
    ' The remainder of your code...

End Sub
VBasic2008
  • 44,888
  • 5
  • 17
  • 28