PC Review


Reply
Thread Tools Rate Thread

COPYING DATA FROM MULTIPLE TABS INTO ONE

 
 
Tree
Guest
Posts: n/a
 
      10th Jun 2009
I put this as a reply on a post, but didn't hear back, so thought it best to
post as its own thread.. Thank you in advance for your assistance.
(I am using the website http://www.rondebruin.nl/copy2.htm)

Hello! Thank you so much for your time and assistance! I have copied the very
helpful macro listed at the website (follows is the example I used) and I
have done something wrong because when I go to run the macro, I get an error
message, INVALID OUTSIDE PROCEDURE. I looked that up and really do not know
how to correct it..
I very much appreciate your assistance.. Follows is what I've inserted in
the module:
The DestSh. in this 2nd line is what's highlighted as part of the error
message..

'Copy header row, change the range if you use more columns
If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
sh.Range("A1:Z1").Copy DestSh.Range("A1")
End If

Sub CopyDataWithoutHeaders()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "RDBMergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"

'Fill in the start row
StartRow = 2

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then

'Find the last row with data on the DestSh and sh
Last = LastRow(DestSh)
shLast = LastRow(sh)

'If sh is not empty and if the last row >= StartRow copy the
CopyRng
If shLast > 0 And shLast >= StartRow Then

'Set the range that you want to copy
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This example copies values/formats, if you only want to
copy the
'values or want to copy everything look below example 1 on
this page
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

End If

End If
Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh 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
End Function

 
Reply With Quote
 
 
 
 
Ron de Bruin
Guest
Posts: n/a
 
      10th Jun 2009
Hi Three

You copy the code to add the header row outside the subroutine

Read this from my page

If you want to copy the header row in the first row of the RDBMergeSheet
then copy the code below if each worksheet have the same headers after
this line : If sh.Name <> DestSh.Name Then

'Copy header row, change the range if you use more columns
If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
sh.Range("A1:Z1").Copy DestSh.Range("A1")
End If

--

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




"Tree" <(E-Mail Removed)> wrote in message news:73746986-0748-4BD5-B1A3-(E-Mail Removed)...
>I put this as a reply on a post, but didn't hear back, so thought it best to
> post as its own thread.. Thank you in advance for your assistance.
> (I am using the website http://www.rondebruin.nl/copy2.htm)
>
> Hello! Thank you so much for your time and assistance! I have copied the very
> helpful macro listed at the website (follows is the example I used) and I
> have done something wrong because when I go to run the macro, I get an error
> message, INVALID OUTSIDE PROCEDURE. I looked that up and really do not know
> how to correct it..
> I very much appreciate your assistance.. Follows is what I've inserted in
> the module:
> The DestSh. in this 2nd line is what's highlighted as part of the error
> message..
>
> 'Copy header row, change the range if you use more columns
> If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
> sh.Range("A1:Z1").Copy DestSh.Range("A1")
> End If
>
> Sub CopyDataWithoutHeaders()
> Dim sh As Worksheet
> Dim DestSh As Worksheet
> Dim Last As Long
> Dim shLast As Long
> Dim CopyRng As Range
> Dim StartRow As Long
>
> With Application
> .ScreenUpdating = False
> .EnableEvents = False
> End With
>
> 'Delete the sheet "RDBMergeSheet" if it exist
> Application.DisplayAlerts = False
> On Error Resume Next
> ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
> On Error GoTo 0
> Application.DisplayAlerts = True
>
> 'Add a worksheet with the name "RDBMergeSheet"
> Set DestSh = ActiveWorkbook.Worksheets.Add
> DestSh.Name = "RDBMergeSheet"
>
> 'Fill in the start row
> StartRow = 2
>
> 'loop through all worksheets and copy the data to the DestSh
> For Each sh In ActiveWorkbook.Worksheets
> If sh.Name <> DestSh.Name Then
>
> 'Find the last row with data on the DestSh and sh
> Last = LastRow(DestSh)
> shLast = LastRow(sh)
>
> 'If sh is not empty and if the last row >= StartRow copy the
> CopyRng
> If shLast > 0 And shLast >= StartRow Then
>
> 'Set the range that you want to copy
> Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
>
> 'Test if there enough rows in the DestSh to copy all the data
> If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
> MsgBox "There are not enough rows in the Destsh"
> GoTo ExitTheSub
> End If
>
> 'This example copies values/formats, if you only want to
> copy the
> 'values or want to copy everything look below example 1 on
> this page
> CopyRng.Copy
> With DestSh.Cells(Last + 1, "A")
> .PasteSpecial xlPasteValues
> .PasteSpecial xlPasteFormats
> Application.CutCopyMode = False
> End With
>
> End If
>
> End If
> Next
>
> ExitTheSub:
>
> Application.Goto DestSh.Cells(1)
>
> 'AutoFit the column width in the DestSh 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
> End Function
>

 
Reply With Quote
 
Tree
Guest
Posts: n/a
 
      10th Jun 2009
I do not understand how to "add the header row outside the subroutine" - I
have copied the text verbatim and put it as the first code in the module but
I still get the error message.

please advise.
Thank you.


"Ron de Bruin" wrote:

> Hi Three
>
> You copy the code to add the header row outside the subroutine
>
> Read this from my page
>
> If you want to copy the header row in the first row of the RDBMergeSheet
> then copy the code below if each worksheet have the same headers after
> this line : If sh.Name <> DestSh.Name Then
>
> 'Copy header row, change the range if you use more columns
> If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
> sh.Range("A1:Z1").Copy DestSh.Range("A1")
> End If
>
> --
>
> Regards Ron de Bruin
> http://www.rondebruin.nl/tips.htm
>
>
>
>
> "Tree" <(E-Mail Removed)> wrote in message news:73746986-0748-4BD5-B1A3-(E-Mail Removed)...
> >I put this as a reply on a post, but didn't hear back, so thought it best to
> > post as its own thread.. Thank you in advance for your assistance.
> > (I am using the website http://www.rondebruin.nl/copy2.htm)
> >
> > Hello! Thank you so much for your time and assistance! I have copied the very
> > helpful macro listed at the website (follows is the example I used) and I
> > have done something wrong because when I go to run the macro, I get an error
> > message, INVALID OUTSIDE PROCEDURE. I looked that up and really do not know
> > how to correct it..
> > I very much appreciate your assistance.. Follows is what I've inserted in
> > the module:
> > The DestSh. in this 2nd line is what's highlighted as part of the error
> > message..
> >
> > 'Copy header row, change the range if you use more columns
> > If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
> > sh.Range("A1:Z1").Copy DestSh.Range("A1")
> > End If
> >
> > Sub CopyDataWithoutHeaders()
> > Dim sh As Worksheet
> > Dim DestSh As Worksheet
> > Dim Last As Long
> > Dim shLast As Long
> > Dim CopyRng As Range
> > Dim StartRow As Long
> >
> > With Application
> > .ScreenUpdating = False
> > .EnableEvents = False
> > End With
> >
> > 'Delete the sheet "RDBMergeSheet" if it exist
> > Application.DisplayAlerts = False
> > On Error Resume Next
> > ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
> > On Error GoTo 0
> > Application.DisplayAlerts = True
> >
> > 'Add a worksheet with the name "RDBMergeSheet"
> > Set DestSh = ActiveWorkbook.Worksheets.Add
> > DestSh.Name = "RDBMergeSheet"
> >
> > 'Fill in the start row
> > StartRow = 2
> >
> > 'loop through all worksheets and copy the data to the DestSh
> > For Each sh In ActiveWorkbook.Worksheets
> > If sh.Name <> DestSh.Name Then
> >
> > 'Find the last row with data on the DestSh and sh
> > Last = LastRow(DestSh)
> > shLast = LastRow(sh)
> >
> > 'If sh is not empty and if the last row >= StartRow copy the
> > CopyRng
> > If shLast > 0 And shLast >= StartRow Then
> >
> > 'Set the range that you want to copy
> > Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
> >
> > 'Test if there enough rows in the DestSh to copy all the data
> > If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
> > MsgBox "There are not enough rows in the Destsh"
> > GoTo ExitTheSub
> > End If
> >
> > 'This example copies values/formats, if you only want to
> > copy the
> > 'values or want to copy everything look below example 1 on
> > this page
> > CopyRng.Copy
> > With DestSh.Cells(Last + 1, "A")
> > .PasteSpecial xlPasteValues
> > .PasteSpecial xlPasteFormats
> > Application.CutCopyMode = False
> > End With
> >
> > End If
> >
> > End If
> > Next
> >
> > ExitTheSub:
> >
> > Application.Goto DestSh.Cells(1)
> >
> > 'AutoFit the column width in the DestSh 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
> > End Function
> >

>

 
Reply With Quote
 
Ron de Bruin
Guest
Posts: n/a
 
      10th Jun 2009
>> If you want to copy the header row in the first row of the RDBMergeSheet
>> then copy the code below if each worksheet have the same headers after
>> this line : If sh.Name <> DestSh.Name Then


If you read the info above it tell you to copy this part

'Copy header row, change the range if you use more columns
If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
sh.Range("A1:Z1").Copy DestSh.Range("A1")
End If

After this code line in the macro
If sh.Name <> DestSh.Name Then

The macro looks like this if you do that

Sub CopyDataWithoutHeaders2()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "RDBMergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"

'Fill in the start row
StartRow = 2

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then

'Copy header row, change the range if you use more columns
If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
sh.Range("A1:Z1").Copy DestSh.Range("A1")
End If

'Find the last row with data on the DestSh and sh
Last = LastRow(DestSh)
shLast = LastRow(sh)

'If sh is not empty and if the last row >= StartRow copy the CopyRng
If shLast > 0 And shLast >= StartRow Then

'Set the range that you want to copy
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This example copies values/formats, if you only want to copy the
'values or want to copy everything look below example 1 on this page
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

End If

End If
Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub




--

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




"Tree" <(E-Mail Removed)> wrote in message news:A2B23554-D6E4-4E55-91BF-(E-Mail Removed)...
>I do not understand how to "add the header row outside the subroutine" - I
> have copied the text verbatim and put it as the first code in the module but
> I still get the error message.
>
> please advise.
> Thank you.
>
>
> "Ron de Bruin" wrote:
>
>> Hi Three
>>
>> You copy the code to add the header row outside the subroutine
>>
>> Read this from my page
>>
>> If you want to copy the header row in the first row of the RDBMergeSheet
>> then copy the code below if each worksheet have the same headers after
>> this line : If sh.Name <> DestSh.Name Then
>>
>> 'Copy header row, change the range if you use more columns
>> If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
>> sh.Range("A1:Z1").Copy DestSh.Range("A1")
>> End If
>>
>> --
>>
>> Regards Ron de Bruin
>> http://www.rondebruin.nl/tips.htm
>>
>>
>>
>>
>> "Tree" <(E-Mail Removed)> wrote in message news:73746986-0748-4BD5-B1A3-(E-Mail Removed)...
>> >I put this as a reply on a post, but didn't hear back, so thought it best to
>> > post as its own thread.. Thank you in advance for your assistance.
>> > (I am using the website http://www.rondebruin.nl/copy2.htm)
>> >
>> > Hello! Thank you so much for your time and assistance! I have copied the very
>> > helpful macro listed at the website (follows is the example I used) and I
>> > have done something wrong because when I go to run the macro, I get an error
>> > message, INVALID OUTSIDE PROCEDURE. I looked that up and really do not know
>> > how to correct it..
>> > I very much appreciate your assistance.. Follows is what I've inserted in
>> > the module:
>> > The DestSh. in this 2nd line is what's highlighted as part of the error
>> > message..
>> >
>> > 'Copy header row, change the range if you use more columns
>> > If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
>> > sh.Range("A1:Z1").Copy DestSh.Range("A1")
>> > End If
>> >
>> > Sub CopyDataWithoutHeaders()
>> > Dim sh As Worksheet
>> > Dim DestSh As Worksheet
>> > Dim Last As Long
>> > Dim shLast As Long
>> > Dim CopyRng As Range
>> > Dim StartRow As Long
>> >
>> > With Application
>> > .ScreenUpdating = False
>> > .EnableEvents = False
>> > End With
>> >
>> > 'Delete the sheet "RDBMergeSheet" if it exist
>> > Application.DisplayAlerts = False
>> > On Error Resume Next
>> > ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
>> > On Error GoTo 0
>> > Application.DisplayAlerts = True
>> >
>> > 'Add a worksheet with the name "RDBMergeSheet"
>> > Set DestSh = ActiveWorkbook.Worksheets.Add
>> > DestSh.Name = "RDBMergeSheet"
>> >
>> > 'Fill in the start row
>> > StartRow = 2
>> >
>> > 'loop through all worksheets and copy the data to the DestSh
>> > For Each sh In ActiveWorkbook.Worksheets
>> > If sh.Name <> DestSh.Name Then
>> >
>> > 'Find the last row with data on the DestSh and sh
>> > Last = LastRow(DestSh)
>> > shLast = LastRow(sh)
>> >
>> > 'If sh is not empty and if the last row >= StartRow copy the
>> > CopyRng
>> > If shLast > 0 And shLast >= StartRow Then
>> >
>> > 'Set the range that you want to copy
>> > Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
>> >
>> > 'Test if there enough rows in the DestSh to copy all the data
>> > If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
>> > MsgBox "There are not enough rows in the Destsh"
>> > GoTo ExitTheSub
>> > End If
>> >
>> > 'This example copies values/formats, if you only want to
>> > copy the
>> > 'values or want to copy everything look below example 1 on
>> > this page
>> > CopyRng.Copy
>> > With DestSh.Cells(Last + 1, "A")
>> > .PasteSpecial xlPasteValues
>> > .PasteSpecial xlPasteFormats
>> > Application.CutCopyMode = False
>> > End With
>> >
>> > End If
>> >
>> > End If
>> > Next
>> >
>> > ExitTheSub:
>> >
>> > Application.Goto DestSh.Cells(1)
>> >
>> > 'AutoFit the column width in the DestSh 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
>> > End Function
>> >

>>

 
Reply With Quote
 
Tree
Guest
Posts: n/a
 
      10th Jun 2009
It is a truly beautiful thing!! THANK YOU!!!!!!!!!!!!!!!!!!!!

"Ron de Bruin" wrote:

> >> If you want to copy the header row in the first row of the RDBMergeSheet
> >> then copy the code below if each worksheet have the same headers after
> >> this line : If sh.Name <> DestSh.Name Then

>
> If you read the info above it tell you to copy this part
>
> 'Copy header row, change the range if you use more columns
> If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
> sh.Range("A1:Z1").Copy DestSh.Range("A1")
> End If
>
> After this code line in the macro
> If sh.Name <> DestSh.Name Then
>
> The macro looks like this if you do that
>
> Sub CopyDataWithoutHeaders2()
> Dim sh As Worksheet
> Dim DestSh As Worksheet
> Dim Last As Long
> Dim shLast As Long
> Dim CopyRng As Range
> Dim StartRow As Long
>
> With Application
> .ScreenUpdating = False
> .EnableEvents = False
> End With
>
> 'Delete the sheet "RDBMergeSheet" if it exist
> Application.DisplayAlerts = False
> On Error Resume Next
> ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
> On Error GoTo 0
> Application.DisplayAlerts = True
>
> 'Add a worksheet with the name "RDBMergeSheet"
> Set DestSh = ActiveWorkbook.Worksheets.Add
> DestSh.Name = "RDBMergeSheet"
>
> 'Fill in the start row
> StartRow = 2
>
> 'loop through all worksheets and copy the data to the DestSh
> For Each sh In ActiveWorkbook.Worksheets
> If sh.Name <> DestSh.Name Then
>
> 'Copy header row, change the range if you use more columns
> If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
> sh.Range("A1:Z1").Copy DestSh.Range("A1")
> End If
>
> 'Find the last row with data on the DestSh and sh
> Last = LastRow(DestSh)
> shLast = LastRow(sh)
>
> 'If sh is not empty and if the last row >= StartRow copy the CopyRng
> If shLast > 0 And shLast >= StartRow Then
>
> 'Set the range that you want to copy
> Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
>
> 'Test if there enough rows in the DestSh to copy all the data
> If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
> MsgBox "There are not enough rows in the Destsh"
> GoTo ExitTheSub
> End If
>
> 'This example copies values/formats, if you only want to copy the
> 'values or want to copy everything look below example 1 on this page
> CopyRng.Copy
> With DestSh.Cells(Last + 1, "A")
> .PasteSpecial xlPasteValues
> .PasteSpecial xlPasteFormats
> Application.CutCopyMode = False
> End With
>
> End If
>
> End If
> Next
>
> ExitTheSub:
>
> Application.Goto DestSh.Cells(1)
>
> 'AutoFit the column width in the DestSh sheet
> DestSh.Columns.AutoFit
>
> With Application
> .ScreenUpdating = True
> .EnableEvents = True
> End With
> End Sub
>
>
>
>
> --
>
> Regards Ron de Bruin
> http://www.rondebruin.nl/tips.htm
>
>
>
>
> "Tree" <(E-Mail Removed)> wrote in message news:A2B23554-D6E4-4E55-91BF-(E-Mail Removed)...
> >I do not understand how to "add the header row outside the subroutine" - I
> > have copied the text verbatim and put it as the first code in the module but
> > I still get the error message.
> >
> > please advise.
> > Thank you.
> >
> >
> > "Ron de Bruin" wrote:
> >
> >> Hi Three
> >>
> >> You copy the code to add the header row outside the subroutine
> >>
> >> Read this from my page
> >>
> >> If you want to copy the header row in the first row of the RDBMergeSheet
> >> then copy the code below if each worksheet have the same headers after
> >> this line : If sh.Name <> DestSh.Name Then
> >>
> >> 'Copy header row, change the range if you use more columns
> >> If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
> >> sh.Range("A1:Z1").Copy DestSh.Range("A1")
> >> End If
> >>
> >> --
> >>
> >> Regards Ron de Bruin
> >> http://www.rondebruin.nl/tips.htm
> >>
> >>
> >>
> >>
> >> "Tree" <(E-Mail Removed)> wrote in message news:73746986-0748-4BD5-B1A3-(E-Mail Removed)...
> >> >I put this as a reply on a post, but didn't hear back, so thought it best to
> >> > post as its own thread.. Thank you in advance for your assistance.
> >> > (I am using the website http://www.rondebruin.nl/copy2.htm)
> >> >
> >> > Hello! Thank you so much for your time and assistance! I have copied the very
> >> > helpful macro listed at the website (follows is the example I used) and I
> >> > have done something wrong because when I go to run the macro, I get an error
> >> > message, INVALID OUTSIDE PROCEDURE. I looked that up and really do not know
> >> > how to correct it..
> >> > I very much appreciate your assistance.. Follows is what I've inserted in
> >> > the module:
> >> > The DestSh. in this 2nd line is what's highlighted as part of the error
> >> > message..
> >> >
> >> > 'Copy header row, change the range if you use more columns
> >> > If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
> >> > sh.Range("A1:Z1").Copy DestSh.Range("A1")
> >> > End If
> >> >
> >> > Sub CopyDataWithoutHeaders()
> >> > Dim sh As Worksheet
> >> > Dim DestSh As Worksheet
> >> > Dim Last As Long
> >> > Dim shLast As Long
> >> > Dim CopyRng As Range
> >> > Dim StartRow As Long
> >> >
> >> > With Application
> >> > .ScreenUpdating = False
> >> > .EnableEvents = False
> >> > End With
> >> >
> >> > 'Delete the sheet "RDBMergeSheet" if it exist
> >> > Application.DisplayAlerts = False
> >> > On Error Resume Next
> >> > ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
> >> > On Error GoTo 0
> >> > Application.DisplayAlerts = True
> >> >
> >> > 'Add a worksheet with the name "RDBMergeSheet"
> >> > Set DestSh = ActiveWorkbook.Worksheets.Add
> >> > DestSh.Name = "RDBMergeSheet"
> >> >
> >> > 'Fill in the start row
> >> > StartRow = 2
> >> >
> >> > 'loop through all worksheets and copy the data to the DestSh
> >> > For Each sh In ActiveWorkbook.Worksheets
> >> > If sh.Name <> DestSh.Name Then
> >> >
> >> > 'Find the last row with data on the DestSh and sh
> >> > Last = LastRow(DestSh)
> >> > shLast = LastRow(sh)
> >> >
> >> > 'If sh is not empty and if the last row >= StartRow copy the
> >> > CopyRng
> >> > If shLast > 0 And shLast >= StartRow Then
> >> >
> >> > 'Set the range that you want to copy
> >> > Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
> >> >
> >> > 'Test if there enough rows in the DestSh to copy all the data
> >> > If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
> >> > MsgBox "There are not enough rows in the Destsh"
> >> > GoTo ExitTheSub
> >> > End If
> >> >
> >> > 'This example copies values/formats, if you only want to
> >> > copy the
> >> > 'values or want to copy everything look below example 1 on
> >> > this page
> >> > CopyRng.Copy
> >> > With DestSh.Cells(Last + 1, "A")
> >> > .PasteSpecial xlPasteValues
> >> > .PasteSpecial xlPasteFormats
> >> > Application.CutCopyMode = False
> >> > End With
> >> >
> >> > End If
> >> >
> >> > End If
> >> > Next
> >> >
> >> > ExitTheSub:
> >> >
> >> > Application.Goto DestSh.Cells(1)
> >> >
> >> > 'AutoFit the column width in the DestSh 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
> >> > End Function
> >> >
> >>

>

 
Reply With Quote
 
Ron de Bruin
Guest
Posts: n/a
 
      10th Jun 2009
You are welcome

--

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




"Tree" <(E-Mail Removed)> wrote in message news:B938539F-7BDB-42D4-83BC-(E-Mail Removed)...
> It is a truly beautiful thing!! THANK YOU!!!!!!!!!!!!!!!!!!!!
>
> "Ron de Bruin" wrote:
>
>> >> If you want to copy the header row in the first row of the RDBMergeSheet
>> >> then copy the code below if each worksheet have the same headers after
>> >> this line : If sh.Name <> DestSh.Name Then

>>
>> If you read the info above it tell you to copy this part
>>
>> 'Copy header row, change the range if you use more columns
>> If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
>> sh.Range("A1:Z1").Copy DestSh.Range("A1")
>> End If
>>
>> After this code line in the macro
>> If sh.Name <> DestSh.Name Then
>>
>> The macro looks like this if you do that
>>
>> Sub CopyDataWithoutHeaders2()
>> Dim sh As Worksheet
>> Dim DestSh As Worksheet
>> Dim Last As Long
>> Dim shLast As Long
>> Dim CopyRng As Range
>> Dim StartRow As Long
>>
>> With Application
>> .ScreenUpdating = False
>> .EnableEvents = False
>> End With
>>
>> 'Delete the sheet "RDBMergeSheet" if it exist
>> Application.DisplayAlerts = False
>> On Error Resume Next
>> ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
>> On Error GoTo 0
>> Application.DisplayAlerts = True
>>
>> 'Add a worksheet with the name "RDBMergeSheet"
>> Set DestSh = ActiveWorkbook.Worksheets.Add
>> DestSh.Name = "RDBMergeSheet"
>>
>> 'Fill in the start row
>> StartRow = 2
>>
>> 'loop through all worksheets and copy the data to the DestSh
>> For Each sh In ActiveWorkbook.Worksheets
>> If sh.Name <> DestSh.Name Then
>>
>> 'Copy header row, change the range if you use more columns
>> If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
>> sh.Range("A1:Z1").Copy DestSh.Range("A1")
>> End If
>>
>> 'Find the last row with data on the DestSh and sh
>> Last = LastRow(DestSh)
>> shLast = LastRow(sh)
>>
>> 'If sh is not empty and if the last row >= StartRow copy the CopyRng
>> If shLast > 0 And shLast >= StartRow Then
>>
>> 'Set the range that you want to copy
>> Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
>>
>> 'Test if there enough rows in the DestSh to copy all the data
>> If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
>> MsgBox "There are not enough rows in the Destsh"
>> GoTo ExitTheSub
>> End If
>>
>> 'This example copies values/formats, if you only want to copy the
>> 'values or want to copy everything look below example 1 on this page
>> CopyRng.Copy
>> With DestSh.Cells(Last + 1, "A")
>> .PasteSpecial xlPasteValues
>> .PasteSpecial xlPasteFormats
>> Application.CutCopyMode = False
>> End With
>>
>> End If
>>
>> End If
>> Next
>>
>> ExitTheSub:
>>
>> Application.Goto DestSh.Cells(1)
>>
>> 'AutoFit the column width in the DestSh sheet
>> DestSh.Columns.AutoFit
>>
>> With Application
>> .ScreenUpdating = True
>> .EnableEvents = True
>> End With
>> End Sub
>>
>>
>>
>>
>> --
>>
>> Regards Ron de Bruin
>> http://www.rondebruin.nl/tips.htm
>>
>>
>>
>>
>> "Tree" <(E-Mail Removed)> wrote in message news:A2B23554-D6E4-4E55-91BF-(E-Mail Removed)...
>> >I do not understand how to "add the header row outside the subroutine" - I
>> > have copied the text verbatim and put it as the first code in the module but
>> > I still get the error message.
>> >
>> > please advise.
>> > Thank you.
>> >
>> >
>> > "Ron de Bruin" wrote:
>> >
>> >> Hi Three
>> >>
>> >> You copy the code to add the header row outside the subroutine
>> >>
>> >> Read this from my page
>> >>
>> >> If you want to copy the header row in the first row of the RDBMergeSheet
>> >> then copy the code below if each worksheet have the same headers after
>> >> this line : If sh.Name <> DestSh.Name Then
>> >>
>> >> 'Copy header row, change the range if you use more columns
>> >> If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
>> >> sh.Range("A1:Z1").Copy DestSh.Range("A1")
>> >> End If
>> >>
>> >> --
>> >>
>> >> Regards Ron de Bruin
>> >> http://www.rondebruin.nl/tips.htm
>> >>
>> >>
>> >>
>> >>
>> >> "Tree" <(E-Mail Removed)> wrote in message news:73746986-0748-4BD5-B1A3-(E-Mail Removed)...
>> >> >I put this as a reply on a post, but didn't hear back, so thought it best to
>> >> > post as its own thread.. Thank you in advance for your assistance.
>> >> > (I am using the website http://www.rondebruin.nl/copy2.htm)
>> >> >
>> >> > Hello! Thank you so much for your time and assistance! I have copied the very
>> >> > helpful macro listed at the website (follows is the example I used) and I
>> >> > have done something wrong because when I go to run the macro, I get an error
>> >> > message, INVALID OUTSIDE PROCEDURE. I looked that up and really do not know
>> >> > how to correct it..
>> >> > I very much appreciate your assistance.. Follows is what I've inserted in
>> >> > the module:
>> >> > The DestSh. in this 2nd line is what's highlighted as part of the error
>> >> > message..
>> >> >
>> >> > 'Copy header row, change the range if you use more columns
>> >> > If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
>> >> > sh.Range("A1:Z1").Copy DestSh.Range("A1")
>> >> > End If
>> >> >
>> >> > Sub CopyDataWithoutHeaders()
>> >> > Dim sh As Worksheet
>> >> > Dim DestSh As Worksheet
>> >> > Dim Last As Long
>> >> > Dim shLast As Long
>> >> > Dim CopyRng As Range
>> >> > Dim StartRow As Long
>> >> >
>> >> > With Application
>> >> > .ScreenUpdating = False
>> >> > .EnableEvents = False
>> >> > End With
>> >> >
>> >> > 'Delete the sheet "RDBMergeSheet" if it exist
>> >> > Application.DisplayAlerts = False
>> >> > On Error Resume Next
>> >> > ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
>> >> > On Error GoTo 0
>> >> > Application.DisplayAlerts = True
>> >> >
>> >> > 'Add a worksheet with the name "RDBMergeSheet"
>> >> > Set DestSh = ActiveWorkbook.Worksheets.Add
>> >> > DestSh.Name = "RDBMergeSheet"
>> >> >
>> >> > 'Fill in the start row
>> >> > StartRow = 2
>> >> >
>> >> > 'loop through all worksheets and copy the data to the DestSh
>> >> > For Each sh In ActiveWorkbook.Worksheets
>> >> > If sh.Name <> DestSh.Name Then
>> >> >
>> >> > 'Find the last row with data on the DestSh and sh
>> >> > Last = LastRow(DestSh)
>> >> > shLast = LastRow(sh)
>> >> >
>> >> > 'If sh is not empty and if the last row >= StartRow copy the
>> >> > CopyRng
>> >> > If shLast > 0 And shLast >= StartRow Then
>> >> >
>> >> > 'Set the range that you want to copy
>> >> > Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
>> >> >
>> >> > 'Test if there enough rows in the DestSh to copy all the data
>> >> > If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
>> >> > MsgBox "There are not enough rows in the Destsh"
>> >> > GoTo ExitTheSub
>> >> > End If
>> >> >
>> >> > 'This example copies values/formats, if you only want to
>> >> > copy the
>> >> > 'values or want to copy everything look below example 1 on
>> >> > this page
>> >> > CopyRng.Copy
>> >> > With DestSh.Cells(Last + 1, "A")
>> >> > .PasteSpecial xlPasteValues
>> >> > .PasteSpecial xlPasteFormats
>> >> > Application.CutCopyMode = False
>> >> > End With
>> >> >
>> >> > End If
>> >> >
>> >> > End If
>> >> > Next
>> >> >
>> >> > ExitTheSub:
>> >> >
>> >> > Application.Goto DestSh.Cells(1)
>> >> >
>> >> > 'AutoFit the column width in the DestSh 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
>> >> > End Function
>> >> >
>> >>

>>

 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Copying data from 100 tabs to one summary page Rob P Microsoft Excel Programming 6 9th Jun 2009 07:55 PM
Copying data from 100 tabs to one summary page Rob P Microsoft Excel Programming 1 27th Mar 2009 03:05 AM
Copying data from 100 tabs to one summary page Rob P Microsoft Excel Programming 0 27th Mar 2009 02:58 AM
Excel 07: Copying data between tabs in a workbook (automatically) ROinBOA Microsoft Excel Misc 0 26th Feb 2008 08:03 PM
Copying formulas for multiple tabs =?Utf-8?B?UGV0ZXI=?= Microsoft Excel Misc 4 16th Mar 2006 10:57 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 11:51 AM.