Hi Ron,

The macro stopped running/failed at the .PasteSpecial XlPasteValues line.

Thoughts?

-Scott

CopyRng.Copy
With DestSh.Cells(Last + 1, "B")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

"Ron de Bruin" wrote:

Hi ScottMSP

Use this


CopyRng.Copy
With DestSh.Cells(Last + 1, "B")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

'Optional: This will copy the sheet name in the A column
DestSh.Cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Name


--

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


"ScottMSP" wrote in message ...
Hello,

I have a follow-up question Ron DeBruin's Macro that merge's worksheets.
I want to be have the sheet name go in column A instead of the last column
after the data. I have tried to tweak this a few different ways, but either
it overwrites the data in column A or the Macro fails.

I suspect this a simple tweak.

Thanks to all who respond.


Sub CopyDataWithoutHeaders_v2()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long

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"

'Fill in the start row
StartRow = 48

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If sh.Name < DestSh.Name And sh.Visible = True Then

'Copy header row, change the range if you use more columns
If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
sh.Range("A2:AH2").Copy DestSh.Range("A1")
End If

'Find the last row with data on the DestSh and sh
Last = Lastrow(DestSh)
shLast = Lastrow(sh)

'If sh is not empty and if the last row = StartRow copy the
CopyRng
If shLast 0 And shLast = StartRow Then

'Set the range that you want to copy
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

'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 below example 1 on
this page
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, "AI").Resize(CopyRng.Rows.Count).Value =
sh.Name

End If

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