Hi Theo

Download the example workbook first to test the code
http://www.rondebruin.nl/copy2.htm

After that change the code


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm




"Theo" wrote in message ...
Thanks Barb and Dave - I made those changes, and I'm worse off than I was
before.
Now the new sheet is created, but nothing is copied.
Dave I am getting the first msg box, but not the second box.
At this point, I've made so many changes, I'm scrapping it and starting over.
I think I'll go back to Ron's site and try again. I must have missed
something. Or,
maybe there is some correction to his code that is captured in the discussion
group comments, but not on his site.
Thanks all.
T


"Barb Reinhardt" wrote:

After these lines put this

'Fill in the range that you want to copy
Set CopyRng = sh.Range("A1").CurrentRegion

last = lastrow(sh)

This is untested, but your variable Last always is Zero since you don't set
it when you copy data. I bet you're copying each sheet, but one sheet
overwrites the next. WHy not put a break point in and see what's happening.

HTH,
Barb Reinhardt

"Theo" wrote
It's copied straight from Ron's Excel Tips, so if it's missing, I'm not sure
where/how to add it.
This is the last bit of code:

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function



"Barb Reinhardt" wrote:

I don't see where you ever define or redefine your variable LAST.

HTH,
Barb Reinhardt

"Theo" wrote:

Hi all - got this code from Ron's site. but it only copies the last worksheet
that begins with 1111; there are 3 worksheets that begin with 1111. HELP!
If each 1111 worksheet has 100 rows, I am expecting the new worksheet to
have 300 rows.

Thanks
T
Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "RDBMergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If LCase(Left(sh.Name, 4)) = "1111" Then


Set CopyRng = sh.Range("A1").CurrentRegion


'Fill in the range that you want to copy
Set CopyRng = sh.Range("A1").CurrentRegion

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This example copies values/formats, if you only want to copy the
'values or want to copy everything look at the example below
this macro
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With


End If
Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function