I have four books that I need to bring one sheet from each into a Maste
book for analysis. The sheets are all in the same format and location.
I have suceeded in pulling the used range from within a workbook bu
not across several workbooks into one.

Can anyone help.

Thanks
Krista

--
Kstalke
-----------------------------------------------------------------------
Kstalker's Profile: http://www.excelforum.com/member.php...fo&userid=2469
View this thread: http://www.excelforum.com/showthread.php?threadid=38267

Hi Kristan,

Try:

Option Explicit
'=========================
Sub TestMe()
Dim WB As Workbook, WBmain As Workbook
Dim Arr As Variant
Dim i As Long
Dim DestSh As Worksheet
Dim SrcSh As Worksheet
Dim Lrow As Long

Application.ScreenUpdating = False

Arr = Array("Book1.xls", "Book2.xls", _
"Book3.xls", "Book4.xls") '<<===== CHANGE

Set WBmain = Workbooks.Add

Set DestSh = WBmain.Worksheets(1)
DestSh.Name = "Summary"

For i = LBound(Arr) To UBound(Arr)
Set WB = Workbooks(Arr(i))
Set SrcSh = WB.Sheets("Sheet1") '<<===== CHANGE

SrcSh.UsedRange.Copy DestSh.Cells(Lrow + 1, 1)
Lrow = LastRow(DestSh)
Next
DestSh.Cells(1).Select

Application.ScreenUpdating = True

End Sub
'<<=========================

'=========================
Function LastRow(sh As Worksheet)
'//Function posted by Ron de Bruin
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
'<<=========================


Replace "Sheet1" with the name of the source sheet in the four workbooks.

Replace "Book1.xls"..."Book4.xls" withyour workbook names.

Consider adding a line to save the newly created summary workbook with a
name with an appended date/time so that chronologically different summary
books can readily be distinguished.

---
Regards,
Norman



"Kstalker" wrote in
message ...

I have four books that I need to bring one sheet from each into a Master
book for analysis. The sheets are all in the same format and location.
I have suceeded in pulling the used range from within a workbook but
not across several workbooks into one.

Can anyone help.

Thanks
Kristan


--
Kstalker
------------------------------------------------------------------------
Kstalker's Profile:
http://www.excelforum.com/member.php...o&userid=24699
View this thread: http://www.excelforum.com/showthread...hreadid=382670

Cheers Norman.

Still falling over unfortunately, subscript out of range

Set WB = Workbooks(Arr(i))

I assume I need to reference workbook location as well.


Any Ideas??


--
Kstalker
------------------------------------------------------------------------
Kstalker's Profile: http://www.excelforum.com/member.php...o&userid=24699
View this thread: http://www.excelforum.com/showthread...hreadid=382670

Hi Kristan

Still falling over unfortunately, subscript out of range

Yes, because my code assumed that the four source workbooks were already
open.

Replace the code with the following version which does not require the
source workbooks to be open:

Option Explicit
'=========================
Sub TestMe()
Dim WB As Workbook, WBmain As Workbook
Dim Arr As Variant
Dim i As Long
Dim DestSh As Worksheet
Dim SrcSh As Worksheet
Dim Lrow As Long
Dim myPath As String

myPath = "C:\MyDocuments" '<<======= CHANGE

If Right(myPath, 1) < "\" Then _
myPath = myPath & "\"

Application.ScreenUpdating = False

Arr = Array("Book1.xls", "Book2.xls", _
"Book3.xls", "Book4.xls") '<<===== CHANGE

Set WBmain = Workbooks.Add

Set DestSh = WBmain.Worksheets(1)
DestSh.Name = "Summary"

Application.DisplayAlerts = False

For i = LBound(Arr) To UBound(Arr)
Set WB = Workbooks.Open(myPath & Arr(i))
Set SrcSh = WB.Sheets("Sheet1") '<<===== CHANGE

SrcSh.UsedRange.Copy DestSh.Cells(Lrow + 1, 1)
Lrow = LastRow(DestSh)
WB.Close (False)
Next
DestSh.Cells(1).Select

With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With

End Sub
'<<=========================

'=========================
Function LastRow(sh As Worksheet)
'//Function posted by Ron de Bruin
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
'<<=========================

In addition to the changes mentioned in my last post, change:
myPath = "C:\MyDocuments"
to the path of the four workbooks

---
Regards,
Norman



"Kstalker" wrote in
message ...

Cheers Norman.

Still falling over unfortunately, subscript out of range

Set WB = Workbooks(Arr(i))

I assume I need to reference workbook location as well.


Any Ideas??


--
Kstalker
------------------------------------------------------------------------
Kstalker's Profile:
http://www.excelforum.com/member.php...o&userid=24699
View this thread: http://www.excelforum.com/showthread...hreadid=382670

Fantastic!

Cheers for that Norman it works a treat.

Another question. Is it possible to take the header row out of the used
range copy for three of the sheets and not for one?

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=382670

Hi Kristan

Another question. Is it possible to take the header row out of the used
range copy for three of the sheets and not for one?

Try:

'=========================
Sub TestMe2()
Dim WB As Workbook, WBmain As Workbook
Dim Arr As Variant
Dim i As Long
Dim DestSh As Worksheet
Dim SrcSh As Worksheet
Dim Lrow As Long
Dim myPath As String
Dim RngToCopy As Range

myPath = "C:\MyDocuments" '<<======= CHANGE

If Right(myPath, 1) < "\" Then _
myPath = myPath & "\"

Application.ScreenUpdating = False

Arr = Array("Book1.xls", "Book2.xls", _
"Book3.xls", "Book4.xls") '<<===== CHANGE


Set WBmain = Workbooks.Add

Set DestSh = WBmain.Worksheets(1)
DestSh.Name = "Summary"

Application.DisplayAlerts = False

For i = LBound(Arr) To UBound(Arr)
Set WB = Workbooks.Open(myPath & Arr(i))
Set SrcSh = WB.Sheets("Sheet1") '<<===== CHANGE

With SrcSh.UsedRange
Set RngToCopy = _
.Offset(1).Resize(.Rows.Count - 1)
If i = 1 Then .Rows(1).Copy DestSh.Cells(1)
End With

RngToCopy.Copy DestSh.Cells(Lrow + 1, 1)
Lrow = LastRow(DestSh)
WB.Close (False)
Next
DestSh.Cells(1).Select

With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With

End Sub
'<<=========================

'=========================
Function LastRow(sh As Worksheet)
'//Function posted by Ron de Bruin
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,
Norman



"Kstalker" wrote in
message ...

Fantastic!

Cheers for that Norman it works a treat.

Another question. Is it possible to take the header row out of the used
range copy for three of the sheets and not for one?

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=382670