consolidate Sheets
 

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

consolidate Sheets
 

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


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"SangelNet" wrote in message oups.com...
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

consolidate Sheets
 

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!

consolidate Sheets
 

Have you also copy the LastRow function in the module ?

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"SangelNet" wrote in message ups.com...
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!

consolidate Sheets
 

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

consolidate Sheets
 

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

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"SangelNet" wrote in message ups.com...
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

consolidate Sheets
 

On Oct 24, 11:37 am, "Ron de Bruin" wrote:
Then I think that there is a empty sheet in your workbook

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"SangelNet" wrote in oglegroups.com...
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

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.

consolidate Sheets
 

Send me the workbook private then i take a look

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"SangelNet" wrote in message ups.com...
On Oct 24, 11:37 am, "Ron de Bruin" wrote:
Then I think that there is a empty sheet in your workbook

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"SangelNet" wrote in oglegroups.com...
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

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.

consolidate Sheets
 

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



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Ron de Bruin" wrote in message ...
Send me the workbook private then i take a look

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"SangelNet" wrote in message ups.com...
On Oct 24, 11:37 am, "Ron de Bruin" wrote:
Then I think that there is a empty sheet in your workbook

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"SangelNet" wrote in oglegroups.com...
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

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.

consolidate Sheets
 

On Oct 24, 2:28 pm, "Ron de Bruin" wrote:
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

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"Ron de Bruin" wrote in .. .

Send me the workbook private then i take a look

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

"SangelNet" wrote in oglegroups.com...
On Oct 24, 11:37 am, "Ron de Bruin" wrote:
Then I think that there is a empty sheet in your workbook

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"SangelNet" wrote in oglegroups.com...
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

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

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

Thnx also for the great info on your page.

consolidate Sheets
 

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

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Sangel" wrote in message oups.com...
On Oct 24, 2:28 pm, "Ron de Bruin" wrote:
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

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"Ron de Bruin" wrote in .. .

Send me the workbook private then i take a look

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

"SangelNet" wrote in oglegroups.com...
On Oct 24, 11:37 am, "Ron de Bruin" wrote:
Then I think that there is a empty sheet in your workbook

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

"SangelNet" wrote in oglegroups.com...
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

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

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

Thnx also for the great info on your page.