Copying a Range from Multiple Worksheets

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

hi E-on,

Last = LastRow(DestSh)

can you show the function "LastRow"

--
isabelle



Le 2012-05-31 15:21, E-on a écrit :
> 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
>
>
>
>

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
On Error GoTo 0
End Function

Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", After:=sh.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
On Error GoTo 0

Isabelle! Thank you for your help!

The lastrow was a function. Please see above

Originally Posted by isabelle

hi E-on,

Last = LastRow(DestSh)

can you show the function "LastRow"

--
isabelle



Le 2012-05-31 15:21, E-on a écrit :
> 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
>
>
>
>

hi E-on,

replace
With DestSh.Cells(Last + 1, "A")

by
With DestSh.Cells(Last + 1, "B")

and

replace
DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name

by
DestSh.Cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Name

--
isabelle



Le 2012-06-03 12:19, E-on a écrit :
> Function LastRow(sh As Worksheet)
> On Error Resume Next
> LastRow = sh.Cells.Find(What:="*", _
> After:=sh.Range("A1"), Lookat:=xlPart,
> LookIn:=xlFormulas, SearchOrder:=xlByRows, _
> SearchDirection:=xlPrevious,
> MatchCase:=False).Row
> On Error GoTo 0
> End Function
>
> Function LastCol(sh As Worksheet)
> On Error Resume Next
> LastCol = sh.Cells.Find(What:="*", After:=sh.Range("A1"),
> Lookat:=xlPart, LookIn:=xlFormulas, _
> SearchOrder:=xlByColumns,
> SearchDirection:=xlPrevious, MatchCase:=False).Column
> On Error GoTo 0
>
> Isabelle! Thank you for your help!
>
> The lastrow was a function. Please see above
>
>
>
>
> isabelle;1602335 Wrote:
>> hi E-on,
>>
>> Last = LastRow(DestSh)
>>
>> can you show the function "LastRow"
>>
>> --
>> isabelle
>>
>>
>>
>> Le 2012-05-31 15:21, E-on a écrit :-
>>> 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
>>>
>>>
>>>
>>> -
>
>
>
>

isabelle! Thank you very much. I have changed the lines and is now working the way I wanted it.