View Full Version : Combine multiple worksheets into one

11-30-2012, 04:30 AM

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
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
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

11-30-2012, 05:23 AM
Sub M_snb()
Application.ScreenUpdating = False

For Each sh In sheets
If left(sh.Name,3)="WE " Then
with sh.Range("A28").currentregion
End With
End If
End Sub

11-30-2012, 05:51 AM
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

11-30-2012, 06:16 AM
Then you have to add a condition to the code.

11-30-2012, 07:39 AM
Had a trawl and really struggling to find any code that would do this.

11-30-2012, 09:44 AM
I think inventing / constructing code is less time consuming than trawling.