Hello Excel gurus.

I found this code on this site and it does just what i need but for one
thing. Instead of nominating workbooks i want to copy one worksheet from
every workbook in folder.

is it possible to do this????



Sub GetData()
Dim WB As Workbook, WBmain As ThisWorkbook
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:\"
If Right(myPath, 1) < "\" Then _
myPath = myPath & "\"

Application.ScreenUpdating = False

Arr = Array(".xls", ".xls", _
".xls", ".xls")

' deletes "master" spreadsheet
Application.DisplayAlerts = False
Worksheets("master").UsedRange.Delete
Application.DisplayAlerts = True

Set WBmain = ThisWorkbook

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

Application.DisplayAlerts = False

For i = LBound(Arr) To UBound(Arr)
Set WB = Workbooks.Open(myPath & Arr(i))
Set SrcSh = WB.Sheets("data")

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

Lrow = LastRow(DestSh)
RngToCopy.Copy DestSh.Cells(Lrow + 1, 1)

WB.Close (False)
Next
DestSh.Cells(1).Select

With Application
..DisplayAlerts = True
..ScreenUpdating = 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


--
workingclassdog
------------------------------------------------------------------------
workingclassdog's Profile: http://www.excelforum.com/member.php...o&userid=25174
View this thread: http://www.excelforum.com/showthread...hreadid=386682