Copying a Range from Multiple Worksheets

[AB33]

I have got the following code from Ron de Bruin’s site. I would like to make an adjustment to this code, but got stuck. Change to be made is highlighted in yellow. After all copies from individual sheets are done in the destination sheet, I would like the name of each files to appear in Column “A” of destination sheet not in Column “H” as per Ron’s code. I have added the following line, inorder to insert a new column in Column “A”. Please help.

DestSh.Columns("A:B").Insert Shift:=xlToRight

In the following steps, you copy a range of data from all worksheets in a workbook and consolidate the

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 summary sheet if it exists.
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    ' Add a new summary worksheet.
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "RDBMergeSheet"

    ' Loop through all worksheets and copy the data to the 
    ' summary worksheet.
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then

            ' Find the last row with data on the summary worksheet.
            Last = LastRow(DestSh)

            ' Specify the range to place the data.
            Set CopyRng = sh.Range("A1:G1")

            ' Test to see whether there are enough rows in the summary
            ' worksheet to copy all the data.
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the " & _
                   "summary worksheet to place the data."
                GoTo ExitTheSub
            End If

            ' This statement copies values and formats from each 
            ' worksheet.
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With

            ' Optional: This statement will copy the sheet 
            ' name in the H column. I would like the name of the sheet to be in Column A of destination sheet, instead of Column H. I have inserted the following line and changed the Column “H” in to “A”, but the code stopped working.


	My Addition	  DestSh.Columns("A:B").Insert Shift:=xlToRight


            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 summary sheet.
    DestSh.Columns.AutoFit

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

[nigelog]

would it not be easier to amend the end of the macro copy column "H" and insert it at "A"

[AB33]

nigelog,
I did try it, but it did not copy the column "A" data from each sheet, and it does not input the name of the sheet on Column "A" either. I am newbie to VBA. This is my assumption.
After the code copies all cells from each sheet to destination sheet, I thought if I insert the line

DestSh.Columns("A:B").Insert Shift:=xlToRight
It will insert a new column and copies the names in to column "A"- the new inserted column, and have also changed DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name in to
DestSh.Cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Name. In doing so, the code actaully does not do anything- i.e does not copy the cells.

[AB33]

Could some one please be any help?