Consolidating sheets

[nc]

I have a few sheets of data with same header and I would
like to put them on the same sheet? What is the easiest
way?

 

[Ron de Bruin]

Try this nc
http://www.rondebruin.nl/copy2.htm

 

[nc]

Hi Ron

I tried using your code at your site

Sub Test1()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long

On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Master").Name) =
0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
Last = LastRow(DestSh)

sh.Range("A1:C5").Copy DestSh.Cells(Last +
1, "A")
'Instead of this line you can use the code
below to copy only the values
'or use the PasteSpecial option to paste
the format also.


'With sh.Range("A1:C5")
'DestSh.Cells(Last + 1, "A").Resize
(.Rows.Count, _
'.Columns.Count).Value = .Value
'End With


'sh.Range("A1:C5").Copy
'With DestSh.Cells(Last + 1, "A")
' .PasteSpecial xlPasteValues, , False,
False
' .PasteSpecial xlPasteFormats, ,
False, False
' Application.CutCopyMode = False
'End With

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

End If
Next
Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The sheet Master already exist"
End If
End Sub


I am getting an error ("Sub or Function not defined") at
this line

Last = LastRow(DestSh)




Please help. Thanks.

-----Original Message-----
Try this nc
http://www.rondebruin.nl/copy2.htm

--
Regards Ron de Bruin
http://www.rondebruin.nl


"nc" <[email protected]> wrote in

message news:[email protected]...

 

[Ron de Bruin]

You forgot to copy the Function LastRow

 

[nc]

Thanks Ron.

What changes to your code is needed if I want to copy only
the selected sheets to a master sheet.

-----Original Message-----
You forgot to copy the Function LastRow

--
Regards Ron de Bruin
http://www.rondebruin.nl


"nc" <[email protected]> wrote in

message news:[email protected]...

 

[nc]

Sorry I forgot to add this to my last post.

The first sheet to be added to the master sheet copy
column header and not for subsequent sheets.


Thanks.

-----Original Message-----
You forgot to copy the Function LastRow

--
Regards Ron de Bruin
http://www.rondebruin.nl


"nc" <[email protected]> wrote in

message news:[email protected]...

 

[Ron de Bruin]

For Each sh In ActiveWindow.SelectedSheets

 

[Ron de Bruin]

Try this

For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
Last = LastRow(DestSh)
If Last = 0 Then
sh.Range("A1:C1").Copy DestSh.Cells(Last + 1, "A")
Last = 1
End If
sh.Range("A2:C5").Copy DestSh.Cells(Last + 1, "A")

 

[nc]

Hi Ron

I tried replacing

For Each sh In ThisWorkbook.Worksheets

with your suggestion. An empty master sheet was created
when only one sheet is selected. If two sheets was
selected the same thing happened plus another empty sheet
was inserted.

-----Original Message-----
For Each sh In ActiveWindow.SelectedSheets


--
Regards Ron de Bruin
http://www.rondebruin.nl


"nc" <[email protected]> wrote in

message news:[email protected]...

 

[nc]

Hi Ron

Thanks for your reply. I tried using this code I got a n
error message "Next without For"

-----Original Message-----
Try this

For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
Last = LastRow(DestSh)
If Last = 0 Then
sh.Range("A1:C1").Copy DestSh.Cells (Last + 1, "A")
Last = 1
End If
sh.Range("A2:C5").Copy DestSh.Cells(Last + 1, "A")


--
Regards Ron de Bruin
http://www.rondebruin.nl


"nc" <[email protected]> wrote in

message news:[email protected]...

 

[Ron de Bruin]

I only copy a part of the code
See the things I changed

I add this lines to the sub

If Last = 0 Then
sh.Range("A1:C1").Copy DestSh.Cells(Last + 1, "A")
Last = 1
End If

 

[Ron de Bruin]

You are right

I did not test it <g>

Add the master sheet manual to your workbook
and delete the code that create the master sheet

You can use it then

 

[nc]

Ron

Thanks.

I could not follow any of the changes you suggested. Can
you please send me the full code including copying only
the selected sheets.

-----Original Message-----
I only copy a part of the code
See the things I changed

I add this lines to the sub

If Last = 0 Then
sh.Range("A1:C1").Copy DestSh.Cells(Last + 1, "A")
Last = 1
End If


--
Regards Ron de Bruin
http://www.rondebruin.nl


"nc" <[email protected]> wrote in

message news:[email protected]...

 

[nc]

Ron

Thanks a lot. The managed to follow your suggestion. I
am still unsure about the selected sheets. That is
deleting the lines for adding the "Master" sheet.

-----Original Message-----
Ron

Thanks.

I could not follow any of the changes you suggested. Can
you please send me the full code including copying only
the selected sheets.

-----Original Message-----
I only copy a part of the code
See the things I changed

I add this lines to the sub

If Last = 0 Then
sh.Range("A1:C1").Copy DestSh.Cells(Last + 1, "A")
Last = 1
End If


--
Regards Ron de Bruin
http://www.rondebruin.nl


"nc" <[email protected]> wrote in

message news:[email protected]... a

n

use

the

1, "D").Value
=

 

[nc]

Ron

Thanks. Please help unsure what lines to delete.

-----Original Message-----
You are right

I did not test it <g>

Add the master sheet manual to your workbook
and delete the code that create the master sheet

You can use it then


--
Regards Ron de Bruin
http://www.rondebruin.nl


"nc" <[email protected]> wrote in

message news:[email protected]...

 

[Ron de Bruin]

Try this example

Add a Sheet named Master to you workbook before you run it.

DestSh.Cells.ClearContents
Every time you run the macro this line clear the contents of the cells in the
"Master" sheet before it add the cells from the selected sheets

Sub Test1()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long

Application.ScreenUpdating = False
Set DestSh = Sheets("Master")
DestSh.Cells.ClearContents
For Each sh In ActiveWindow.SelectedSheets
If sh.Name <> DestSh.Name Then
Last = LastRow(DestSh)
If Last = 0 Then
sh.Range("A1:C1").Copy DestSh.Cells(Last + 1, "A")
Last = 1
End If
sh.Range("A2:C5").Copy DestSh.Cells(Last + 1, "A")
DestSh.Cells(Last + 1, "D").Value = sh.Name
End If
Next
Application.ScreenUpdating = True
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





--
Regards Ron de Bruin
http://www.rondebruin.nl

Ron

Thanks a lot. The managed to follow your suggestion. I
am still unsure about the selected sheets. That is
deleting the lines for adding the "Master" sheet.

 

[nc]

Thanks a lot Ron.

-----Original Message-----
Try this example

Add a Sheet named Master to you workbook before you run it.

DestSh.Cells.ClearContents
Every time you run the macro this line clear the contents of the cells in the
"Master" sheet before it add the cells from the selected sheets

Sub Test1()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long

Application.ScreenUpdating = False
Set DestSh = Sheets("Master")
DestSh.Cells.ClearContents
For Each sh In ActiveWindow.SelectedSheets
If sh.Name <> DestSh.Name Then
Last = LastRow(DestSh)
If Last = 0 Then
sh.Range("A1:C1").Copy DestSh.Cells(Last + 1, "A")
Last = 1
End If
sh.Range("A2:C5").Copy DestSh.Cells(Last + 1, "A")
DestSh.Cells(Last + 1, "D").Value = sh.Name
End If
Next
Application.ScreenUpdating = True
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





--
Regards Ron de Bruin
http://www.rondebruin.nl


"nc" <[email protected]> wrote in

message news:[email protected]...