How should I change Macro?

[Kiba]

I have a code which creates a master list from all the other worksheets in
the workbook. I need it to list the worksheet name in every row it copies.
Right now it only does it for the first line. Here is the code.
__________________

Sub Merge()

Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "MergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("MergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "MergeSheet"
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "MergeSheet"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
Last = LastRow(DestSh)

'This example copies everything, if you only want to copy
'values/formats look at the example below this macro

sh.UsedRange.Copy DestSh.Cells(Last + 1, "A")

'This will copy the sheet name in the Q column if you want
DestSh.Cells(Last + 1, "Q").Value = sh.Name

End If
Next

Application.Goto DestSh.Cells(1)

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

Macro1
Macro2
HideRows


End Sub
______________________________
Thanks for the help

 

[Vergel Adriano]

Kiba,

try replacing this line

DestSh.Cells(Last + 1, "Q").Value = sh.Name

with this :

With DestSh
.Range(.Cells(Last + 1, "Q"), .Cells(sh.UsedRange.Rows.Count,
"Q")).Value = sh.Name
End With

 

[Kiba]

Well I tried it and it posted it to most of the cells but not all of them.
Also it posted it to a bunch of blank cells as well.

 

[Vergel Adriano]

sorry, it should be like this:

With DestSh
.Range(.Cells(Last + 1, "Q"), .Cells(Last + 1 + sh.UsedRange.Rows.Count,
"Q")).Value = sh.Name
End With

 

[Kiba]

Thanks that seems to have done it.

sorry, it should be like this:

With DestSh
.Range(.Cells(Last + 1, "Q"), .Cells(Last + 1 + sh.UsedRange.Rows.Count,
"Q")).Value = sh.Name
End With