Combine multiple worksheets into one

[Hoopsah]

Hi

I have copied this code from elsewhere:

Function wsExists(wksName As String) As Boolean
On Error Resume Next
wsExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function
Sub Combine()
Dim destSH As Worksheet, sh As Worksheet
Dim rw As Long
Application.DisplayAlerts = False
If wsExists("Summary") Then
Sheets("Summary").Delete
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = False
Set destSH = Worksheets.Add(After:=Worksheets(Worksheets.Count))
destSH.Name = "Summary" '<----- This will add a sheet named "Summary".
rw = 2
For Each sh In Worksheets
If sh.Name <> destSH.Name Then
sh.Range("A28:Z28").Copy
With destSH.Cells(rw, 1)
.PasteSpecial Paste:=xlPasteValues
End With
rw = rw + 2
End If
Next sh
Application.ScreenUpdating = True
End Sub


However, I cant quite get it to work properly.

I am looking for it to copy a specific range of worksheets into 1 summary worksheet, columns begin on A28 across to Z28 but will have varying rows on each worksheet.

The other thing is that I don't want the first 7 tabs copied, all of the ones I want will begin with tab name "WE xxxxxxx"

All help appreciated

[snb]

Sub M_snb()
Application.ScreenUpdating = False

For Each sh In sheets
If left(sh.Name,3)="WE " Then
with sh.Range("A28").currentregion
sheets("summary").cells(rows.count,1).end(xlup).offset(1).resize(.rows.count,26)=.value
End With
End If
Next
End Sub

[Hoopsah]

Works really well, thank you.

Now, what if the data in one of the sheets is Blank (I know I should have stated this first time but only just realised) ;)

The header row is there but no data to copy

[snb]

Then you have to add a condition to the code.

[Hoopsah]

Had a trawl and really struggling to find any code that would do this.

[snb]

I think inventing / constructing code is less time consuming than trawling.