Ron DeBruin Macro - Moving Sheet Name from Last Column to Column A

[ScottMSP]

Hello,

I have a follow-up question re: 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

 

[Ron de Bruin]

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

 

[ScottMSP]

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]

Hi Scott

Yes, you copy all columns(full rows) to column B so that will not fit
You must change the range to

Set CopyRng = sh.Range("A" & StartRow & ":Z" & shLast)

This copy column A to Z

 

[ScottMSP]

Hi Ron,

Thanks so much. Worked like a charm. I had a feeling it had something to
do with pasting a whole row, but my knowledge of VBA is very limited and so
when I tried to tweak, I could not find the right sequence to make it work.

Do you have any recommendations of books that might be useful for an
advanced Excel user who is learning to write Macros to get the
basics/foundational in how to write macros to do this type of programming?

Thanks again.

 

[Ron de Bruin]

Hi Scott

Nice gift for Christmas

http://www.amazon.com/gp/product/0764540726

Or the 2007 version
http://www.amazon.com/gp/product/0470044012

 

[ScottMSP]

Thanks Ron,

Looks excellent and just right for me.

You are the best!

-Scott

 

[Ron de Bruin]

You are welcome