Loop through worksheet list to copy and paste data into a summary sheet

[benajamingeldart]

Hi folks, I need some help.

I have 2 workbooks, WB1 contains loads of data and WB2 contains a list of all the worksheets in WB1 against which I want to copy and paste part of the data from WB1 into a WB2 summary table.
I have a macro called 'Pulldata' which will search for a cell value and copy a range of data but have no way of automating this back into WB2 against the correct worksheet name then moving onto the next value in the WB1 list.
Any way of doing this with VBA looping or a vba vlookup worksheet name or something.

Thanks.

Ben

 

[mumps]

You are very welcome.

 

[benajamingeldart]

Hi MUMPS, Just coming up with a debug error now when a sheet doesn't contain "Strain Test Results". How do i skip to the Next ws if fnd=nothing please?

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWB As Workbook, desWS As Worksheet, ws As Range, fnd As Range, cnt As Long, lCol As Long
    Set srcWB = Workbooks("Source Data.xlsx")
    Set desWS = ThisWorkbook.Sheets("BC Sediment Summary")
    LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each ws In desWS.Range("A2:A" & LastRow).SpecialCells(xlCellTypeConstants)
        With srcWB.Sheets(ws.Value)
            Set fnd = .Range("N:N").Find("Strain Test Results", LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                cnt = fnd.MergeArea.Rows.Count
                lCol = .Cells(fnd.Row, Columns.Count).End(xlToLeft).Column
                .Cells(fnd.Row, fnd.Column + 1).Resize(cnt, lCol - fnd.Column).Copy desWS.Cells(ws.Row, 5)
            End If
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub

 

[benajamingeldart]

Great stuff thanks.

 

[mumps]

My pleasure.