Since I am able to get the script to error out, I thought it was understood
that I know the steps of 1-5. That is a given.
Please disregard my question about where to paste the common function code.
I pasted it at the end of the "Copy a range of each sheet" code and ended up
undesired results and with the error "There are not enough rows in the
Destsh". Below is the code and a sample of the results.
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 sh.Name <> DestSh.Name Then
'Find the last row with data on the DestSh
Last = LastRow(DestSh)
'Fill in the range that you want to copy
Set CopyRng = sh.Range("A:C")
'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
'Optional: This will copy the sheet name in the H column
DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value =
sh.Name
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
RESULTS
Date Description Amount 7-Dec
12/7/2007 Purchase Description $5.98 7-Dec
12/7/2007 Purchase Description $22.40 7-Dec
12/8/2007 Purchase Description $21.60 7-Dec
12/8/2007 Purchase Description $48.29 7-Dec
12/8/2007 Purchase Description $85.25 7-Dec
12/8/2007 Purchase Description $125.98 7-Dec
12/8/2007 Purchase Description $3.45 7-Dec
12/8/2007 Purchase Description $39.94 7-Dec
12/8/2007 Purchase Description $21.07 7-Dec
The results only displayed data from the first sheet of the workbook and it
converts the name of first sheet from "Dec07" to "7-Dec" and fills this data
down the entire H column, all 1048576 rows; hence the error message.
PS - The link provided with your response was broken and once I found my
post, I received a message "Community Message Not Available". I had to click
on the ? mark and then I was able to see your recent response.
Thanks,
Melanie
