Consolidate data from multiple sheets

[jimmisavage]

Hi, I hope someone might be able to help me.

I have a sheets named "Contact Details" and multiple sheets named "*** Patients" (Where *** could be any word or words).

I need "Contact Details" to consolidate the data from the other sheets into one sheet based on the following criteria:

IF sheet name ends with "Patients" AND AF1="Commercial" (if anything else do nothing) copy data from A2:K(last row with data) into "Contact Details".

What would be the best way to do this? I would prefer a formula but I don't know if that will be possible?

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    For Each ws In Sheets
        If ws.Name <> "Contact Details" Then
            If ws.Range("AF1") = "Commercial" Then
                ws.Range("A2:K" & ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row).Copy Sheets("Contact Details").Cells(Sheets("Contact Details").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

The macro assumes that there is one sheet named "Contact Details" and all other sheets are the "Patient" sheets.

 

[jimmisavage]

Hi mumps, there are lots of other sheets which I don't want to include. Is there a way to only include those that end with "Patients"?

 

[gallen]

Beat me to it but I've just written it so you may as well have it!

Sub GetData()


Dim ws As Worksheet 'used in loop
Dim wsPaste As Worksheet 'Contact Details
Dim lr As Long 'last used row
Dim nr As Long 'next available row to paste to


    Set wsPaste = Sheets("Contact Details")
    
    'loop thorugh all sheets in workbook
    For Each ws In ThisWorkbook.Worksheets
        'is the last 8 characters 'Patients' and is AF1 'Commercial'?
        If Right(ws.Name, 8) = "Patients" And ws.Range("AF1") = "Commercial" Then
            lr = ws.Range("K" & Rows.Count).End(xlUp).Row
            ws.Range("A2:K" & lr).Copy
            nr = wsPaste.Range("A" & Rows.Count).End(xlUp).Row
            wsPaste.Range("A" & nr).PasteSpecial
        End If
    Next ws


End Sub

 

[jimmisavage]

Gallen, that's the badger! Works perfectly, thanks a million

 

[mumps]

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    For Each ws In Sheets
        If ws.Name Like "*Patients" Then
            If ws.Range("AF1") = "Commercial" Then
                ws.Range("A2:K" & ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row).Copy Sheets("Contact Details").Cells(Sheets("Contact Details").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub