how to copy data from non-consecutive columns and paste in another sheet using vba

[bebe1279]

Hi everyone

I'm trying to get this to work but I just don't have a lot of experience with VBA.
What I'm trying to do is to get data from "sheet3", columns 1, 2 and 5 and paste them on the "summary" sheet starting at row A7.

The workbook that I'm working with has 37 sheets, 35 of those sheets contains data in columns 1, 2 & 5 (in all sheets) that I'd like to display on the "summary" sheet. the summary sheet is divided into to "charts"; the first is from A7 to D13 and the second is from A22 to D49. if anyone could help with fixing the below code, that would be great. Also, if anyone has a better way of doing it I'd really appreciate it. I was going to copy/paste the code 30+x and simply change the sheet name etc.

Application.ScreenUpdating = 0

'With Worksheets("1235 Law 11-8a")
With Sheet3 'using index,shorter neam

 ' Find last row of data
  lr = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

  x = 7
  
        For i = 2 To lr
            If Range("A" & i) <> "" Then
                .Range(.Cells(i, 1), .Cells(i, 2), .Cells(i, 5)).Copy
               With Worksheets("SUMMARY")
                    .Cells(x, 1).PasteSpecial xlPasteFormulasAndNumberFormats
               End With
            End If
        Next i

End With
 
With Application
        .CutCopyMode = False
        .ScreenUpdating = 1
    End With

End Sub

 

[Peter_SSs]

1. My understanding is that the number of sheets for each vendor can vary. So when we come to any particular sheet in the workbook, how do we know whether that sheet belongs to vendor A or vendor B?

2. For any of the vendor worksheets, if we find the last row in column A, will that also be the last row in columns B & E, or can the last row in each column be different?

 

[tlowry]

Good points by Peter_SSs

Also, do any of the data have headers?

 

[bebe1279]

Hi tlowry

Thanks for all your efforts. however, the code didn't work for me. When I run the code I get the first and last invoices only, but they generate starting in row 22 and they repeat three time each.
this code works better but for some reason rows 8-15 & 20 which are blank are skipped. what I'd like to do is have the data fall into row 7-13.
Any ideas as to why it is skipping the rows and how I can fix it?

Sub test()

Dim yws As Worksheet
Dim lr As Long
Dim adr As String
Dim jobt As Long
Dim bal As Long

'Loop through worksheets of array
For Each yws In Sheets(Array(Sheets(3).Name, Sheets(4).Name, Sheets(5).Name, Sheets(6).Name, Sheets(7).Name, Sheets(8).Name, Sheets(9).Name))
    With yws
    'find last row of data
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    
    'add values to variables
    adr = .Cells(lr, 1).Value
    jobt = .Cells(lr, 2).Value
    bal = .Cells(lr, 5).Value
    End With
        'dump data into summary sheet
        With Worksheets("SUMMARY")
        'start at row 7
         erow = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
         If x = "" Then x = 7 Else x = erow
            'assign values to cells
            .Cells(x, 1).Value = adr
            .Cells(x, 2).Value = jobt
            .Cells(x, 3).Value = bal
        End With
Next yws

End Sub

 

[tlowry]

I did some (a bunch) of cleanup on your code and came up with:

Sub YAT()
    Dim yws, lryws, lrsum, x
    With Sheets("SUMMARY")
        For Each yws In Sheets(Array(Sheets(3).Name, Sheets(4).Name)) 'fix this
            lryws = yws.Cells(Rows.Count, 1).End(xlUp).Row
            For x = 1 To lryws
                lrsum = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                If lrsum < 7 Then lrsum = 7
                .Cells(lrsum, 1) = yws.Cells(x, 1)
                .Cells(lrsum, 2) = yws.Cells(x, 2)
                .Cells(lrsum, 3) = yws.Cells(x, 5)
             Next x
        Next yws
    End With
End Sub Sub

Give it a go...