Looping through all workbooks

A

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
 
M

Mervyn Thomas

Many thanks - about test
Mervyn

Abdul Salam said:
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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top