consolidate Sheets

[SangelNet]

Hi
Im using the code from the the following link:

http://www.rodenbruin.nl/copy2.htm

it goes like this
Sub merge()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim shLast As Long
Dim Last As Long

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

sh.Range(sh.Rows(2), sh.Rows(shLast)).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(sh.Rows(3), sh.Rows(shLast))
'DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _
'.Columns.Count).Value = .Value
'End With

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

End If
Next
DestSh.Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The sheet Merge already exist"
End If
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

What can i add to the code if i want it to run thru all the sheets
except one in specific, lets say its called "maindata".

thnx

 

[Ron de Bruin]

Hi SangelNet

There are a few examples on the site

But you can do this

If sh.Name <> DestSh.Name And sh.Name <> "maindata" Then

 

[SangelNet]

Hi Ron

Did the change.
It starts doing the merge, then im getting an error on this line

sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A")

cant seem to pint out whats wrong!

 

[Ron de Bruin]

Have you also copy the LastRow function in the module ?

 

[SangelNet]

Yes Sir, I added the lastrow function. The code im using at this point
and getting error is this:

Sub merge()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast 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 And sh.Name <> "maindata" Then
Last = LastRow(DestSh)
shLast = LastRow(sh)

'This example copies everything, if you only want to copy
'values/formats look at the example below the first
example
sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy
DestSh.Cells(Last + 1, "A")

End If
Next

Application.Goto DestSh.Cells(1)

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

 

[Ron de Bruin]

Then I think that there is a empty sheet in your workbook

 

[SangelNet]

Then I think that there is a empty sheet in your workbook

No, No blanks. Actually now its merging just 2 of the sheets and then
giving the error. tried doing it with new clean sheets, still.
I will keep trying.

 

[Ron de Bruin]

Send me the workbook private then i take a look

 

[Ron de Bruin]

Hi SangelNet

There are 3 sheets with data(V) in one cell in row
65338
65246
65399

So your range is to big to copy to one sheet
Use Ctrl-end on each sheet and you will find your last cell

 

[Sangel]

Hi SangelNet

There are 3 sheets with data(V) in one cell in row
65338
65246
65399

So your range is to big to copy to one sheet
Use Ctrl-end on each sheet and you will find your last cell

Ron

That definitely was it.
Thnx so much, you've been very kind.

Thnx also for the great info on your page.

 

[Ron de Bruin]

You are welcome

I will add a row.count check soon in the macros on that page.
In my workbook merge examples I already add that in the example code