Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
help getting code from ron de bruins site | Excel Programming | |||
VB code to concatenate 100+ cells | Excel Programming | |||
post code & suburb concatenate | Excel Discussion (Misc queries) | |||
I know how to concatenate ,can one de-concatenate to split date? | New Users to Excel | |||
Ron de Bruins Delete Row Code Q | Excel Programming |