Looping through all workbooks

[Abdul Salam]

Try somethin like this:

(un tested)


Public Sub GetData()

Dim MyDir As String
Dim MyFType As String
Dim MyWbook As String
Dim MyTWbook As String
Dim MyOpenWbook As Workbook
Dim MySheet As Worksheet
Dim MyCell As Range

MyTBook = "C:\My Directory\My Files\My Master
file.xls"
MyTBook.Open
MyDir = "C:\My Directory\My Files"
MyFType = "*.XLS"
MyWbook = Dir(MyDir & "\" & MyFType)
Do
Set MyOpenWbook = Workbooks.Open(MyDir & "\" &
MyWbook)
For Each MySheet In MyOpenWbook
If MySheet.Visible = True Then
MySheet.Range("A1").Copy
MyTBook.Activate
Range("A65536").End(xlUp).Offset(1,
0).Select
ActiveSheet.Paste
End If
Next MySheet

MyOpenWbook.Save
MyOpenWbook.Close
MyWbook = Dir()
Loop Until MyWbook = ""

End Sub


Abdul Salam

 

[Mervyn Thomas]

Many thanks - about test
Mervyn

Try somethin like this:

(un tested)


Public Sub GetData()

Dim MyDir As String
Dim MyFType As String
Dim MyWbook As String
Dim MyTWbook As String
Dim MyOpenWbook As Workbook
Dim MySheet As Worksheet
Dim MyCell As Range

MyTBook = "C:\My Directory\My Files\My Master
file.xls"
MyTBook.Open
MyDir = "C:\My Directory\My Files"
MyFType = "*.XLS"
MyWbook = Dir(MyDir & "\" & MyFType)
Do
Set MyOpenWbook = Workbooks.Open(MyDir & "\" &
MyWbook)
For Each MySheet In MyOpenWbook
If MySheet.Visible = True Then
MySheet.Range("A1").Copy
MyTBook.Activate
Range("A65536").End(xlUp).Offset(1,
0).Select
ActiveSheet.Paste
End If
Next MySheet

MyOpenWbook.Save
MyOpenWbook.Close
MyWbook = Dir()
Loop Until MyWbook = ""

End Sub


Abdul Salam