Home |
Search |
Today's Posts |
#1
![]() |
|||
|
|||
![]()
I have posted it in other forms, but have not got any answer. I hope Banters would do the magic for me.
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, in order to insert a new column in Column “A”. Please help. DestSh.Columns("A:B").Insert Shift:=xlToRigh 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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Copying multiple cells out of multiple worksheets at same time. | Excel Discussion (Misc queries) | |||
Copying a range of data across multiple worksheets | Excel Programming | |||
Copying a range of data across multiple worksheets | Excel Programming | |||
Copying multiple Worksheets | Excel Discussion (Misc queries) | |||
Copying from multiple worksheets | Excel Discussion (Misc queries) |