More used range Q's

[Kstalker]

I am trying to copy the used range from a specified selection of worksheets, this time within
one workbook. I only want to take the header row from one sheet and not from the rest. I have used the helpful tip outlined below (only segment of code) but it copies all worksheets within the workbook with all headers included.


Sub CopyUsedRange()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
If SheetExists("Master") = True Then
MsgBox "The sheet Master already exist"
Exit Sub
End If
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
If sh.UsedRange.Count > 1 Then
Last = LastRow(DestSh)
sh.UsedRange.Copy DestSh.Cells(Last + 1, 1)
End If
End If
Next
Application.ScreenUpdating = True
End Sub

Similar to my other post but I have outlined more and refined my direction.
Thanks in advance.

Kristan

[Norman Jones]

Hi Kristan,

See Ron De Bruin's web site for a whole range of copy Cell(s) \ Range \
Sheet \ Workbook routines copy at:

http://www.rondebruin.nl/tips.htm


---
Regards,
Norman



"Kstalker" <Kstalker.1rczua_1119999936.6832@excelforum-nospam.com> wrote in
message news:Kstalker.1rczua_1119999936.6832@excelforum-nospam.com...
>
> I am trying to copy the used range from a specified selection of
> worksheets, this time within
> one workbook. I only want to take the header row from one sheet and not
> from the rest. I have used the helpful tip outlined below (only segment
> of code) but it copies all worksheets within the workbook with all
> headers included.
>
>
> Sub CopyUsedRange()
> Dim sh As Worksheet
> Dim DestSh As Worksheet
> Dim Last As Long
> If SheetExists("Master") = True Then
> MsgBox "The sheet Master already exist"
> Exit Sub
> End If
> Application.ScreenUpdating = False
> Set DestSh = Worksheets.Add
> DestSh.Name = "Master"
> For Each sh In ThisWorkbook.Worksheets
> If sh.Name <> DestSh.Name Then
> If sh.UsedRange.Count > 1 Then
> Last = LastRow(DestSh)
> sh.UsedRange.Copy DestSh.Cells(Last + 1, 1)
> End If
> End If
> Next
> Application.ScreenUpdating = True
> End Sub
>
> Similar to my other post but I have outlined more and refined my
> direction.
> Thanks in advance.
>
> Kristan
>
>
> --
> Kstalker
> ------------------------------------------------------------------------
> Kstalker's Profile:
> http://www.excelforum.com/member.php...o&userid=24699
> View this thread: http://www.excelforum.com/showthread...hreadid=382970
>

[Norman Jones]

Hi Kristan,

Looking again, I see that the code you show *is* Ron de Bruin's.

Try this adaptation of Ron's code (on a copy of your workbook!) and see if
it satisfies your requirements.

I have included the Ron's LastRow function and the Chip Pearson SheetExists
function for completenes and as these are required by the sub.

Sub CopyUsedRange()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim RngToCopy As Range
Dim Arr As Variant
Dim WB As Workbook
Dim i As Long

Set WB = ActiveWorkbook '<<===== CHANGE or KEEP

Arr = Array("Sheet1", "Sheet2", "Sheet3") '<<==== CHANGE

If SheetExists("Master", WB) = True Then
MsgBox "The sheet Master already exist"
Exit Sub
End If

Application.ScreenUpdating = False
Set DestSh = WB.Worksheets.Add
DestSh.Name = "Master"

For i = LBound(Arr) To UBound(Arr)
Set sh = Sheets(Arr(i))

With sh.UsedRange

If i = 1 Then .Rows(1).Copy DestSh.Cells(1)

Set RngToCopy = .Offset(1).Resize(.Rows.Count - 1)
If i = 1 Then .Rows(1).Copy DestSh.Cells(1)

End With

If sh.UsedRange.Count > 1 Then
Last = LastRow(DestSh)
RngToCopy.Copy DestSh.Cells(Last + 1, 1)
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:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
'Chip Pearson
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(WB.Sheets(SName).Name))
End Function

'<<=================
---
Regards,
Norman



"Kstalker" <Kstalker.1rczua_1119999936.6832@excelforum-nospam.com> wrote in
message news:Kstalker.1rczua_1119999936.6832@excelforum-nospam.com...
>
> I am trying to copy the used range from a specified selection of
> worksheets, this time within
> one workbook. I only want to take the header row from one sheet and not
> from the rest. I have used the helpful tip outlined below (only segment
> of code) but it copies all worksheets within the workbook with all
> headers included.
>
>
> Sub CopyUsedRange()
> Dim sh As Worksheet
> Dim DestSh As Worksheet
> Dim Last As Long
> If SheetExists("Master") = True Then
> MsgBox "The sheet Master already exist"
> Exit Sub
> End If
> Application.ScreenUpdating = False
> Set DestSh = Worksheets.Add
> DestSh.Name = "Master"
> For Each sh In ThisWorkbook.Worksheets
> If sh.Name <> DestSh.Name Then
> If sh.UsedRange.Count > 1 Then
> Last = LastRow(DestSh)
> sh.UsedRange.Copy DestSh.Cells(Last + 1, 1)
> End If
> End If
> Next
> Application.ScreenUpdating = True
> End Sub
>
> Similar to my other post but I have outlined more and refined my
> direction.
> Thanks in advance.
>
> Kristan
>
>
> --
> Kstalker
> ------------------------------------------------------------------------
> Kstalker's Profile:
> http://www.excelforum.com/member.php...o&userid=24699
> View this thread: http://www.excelforum.com/showthread...hreadid=382970
>

[Kstalker]

Didn't intend on sounding like a plagarist, Ron de Bruin's code worked a treat.

That adaptation is on the money, with one exception. Still misses the first row on the first sheet. (not header) Otherwise pulls everything together perfectly. Any idea how to include that initial row?

Thanks again
Kristan

[Norman Jones]

Hi Kristan,

In the line:

If i = 1 Then .Rows(1).Copy DestSh.Cells(1)

try changing i=1 to i=2.


> Didn't intend on sounding like a plagarist, Ron de Bruin's code worked a
> treat.

And no such intention on my part to suggest this. In any event, I am sure
that Ron is only too happy for his published code to be used.

The comment to which you have responded was a metaphoric wry smile at
myself: I advised you to look at Ron's code offerings and you already had!

---
Regards,
Norman



"Kstalker" <Kstalker.1rd882_1120010798.9987@excelforum-nospam.com> wrote in
message news:Kstalker.1rd882_1120010798.9987@excelforum-nospam.com...
>
> Didn't intend on sounding like a plagarist, Ron de Bruin's code worked a
> treat.
>
> That adaptation is on the money, with one exception. Still misses the
> first row on the first sheet. (not header) Otherwise pulls everything
> together perfectly. Any idea how to include that initial row?
>
> Thanks again
> Kristan
>
>
> --
> Kstalker
> ------------------------------------------------------------------------
> Kstalker's Profile:
> http://www.excelforum.com/member.php...o&userid=24699
> View this thread: http://www.excelforum.com/showthread...hreadid=382970
>

[Norman Jones]

Hi Kristan,

Typo warning!

> try changing i=1 to i=2.

should read:

> try changing i=1 to i=0

..
---
Regards,
Norman



"Norman Jones" <normanjones@whereforartthou.com> wrote in message
news:u$TMK4IfFHA.3788@tk2msftngp13.phx.gbl...
> Hi Kristan,
>
> In the line:
>
> If i = 1 Then .Rows(1).Copy DestSh.Cells(1)
>
> try changing i=1 to i=2.
>
>

[Kstalker]

All good.

Thanks for your knowledge and tenacity Norman.

Regards

Kristan