LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 66
Default ron de bruins code won't concatenate

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


 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
help getting code from ron de bruins site funkymonkUK[_140_] Excel Programming 2 April 24th 06 08:31 PM
VB code to concatenate 100+ cells LJones[_3_] Excel Programming 3 February 1st 06 06:43 PM
post code & suburb concatenate varun Excel Discussion (Misc queries) 3 December 14th 05 09:18 AM
I know how to concatenate ,can one de-concatenate to split date? QUICK BOOKS PROBLEM- New Users to Excel 1 July 26th 05 05:07 PM
Ron de Bruins Delete Row Code Q John Excel Programming 0 June 8th 04 11:16 PM


All times are GMT +1. The time now is 05:23 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"