View Single Post
  #1   Report Post  
Royzer Royzer is offline
Junior Member
 
Posts: 21
Default

Quote:
Originally Posted by Bruno Campanini[_2_] View Post
Royzer brought next idea :
I have 30 files, each in a different folder on a network drive. I need
to be able to copy the top 100 rows from the first sheet of each file
and paste them into a single sheet in a master file on a monthly basis.
(If that is not possible, I guess I could copy them to separate sheets
and link all of the sheets to a "master" sheet in my master workbook.)

There are other Excel files in these directories, but the files I need
to copy this range from share the word "Source" in the workbook name.The
sheet name of the first sheet in every file is "CASH".

The copy and paste from the first file would fill rows 1 - 100 on the
master sheet. The data from the second file would paste on rows 101 -
200 in the master sheet, and so forth. After all the data has been
copied and pasted the file would automatically save. Some directory
examples:

S:\Accounting\Film\WOLB\WOLB Source File.xls

S:\Accounting\Film\WITX\WITX Source File.xls

S:\Accounting\Film\WBBB\WBBB Source File.xls

If you can help me I would REALLY appreciate it. I've been unable to
find a solution to this anywhere.


Try this and report any bugs.
===========================================
Public Sub CollectFromEverywhere()
Dim FS As New FileSystemObject
Dim FS_subFolders As Object
Dim FS_Folders As Object, SourceFile As Object
Dim FS_Files As Object, xlApp As New Excel.Application
Dim colFolders_1 As Collection, SourceRange As Range
Dim colFolders_2 As Collection, n As Long, m As Long
Dim i, j, k, h As Long, NumRow As Integer, NumCol As Integer
Dim TargetRange As Range, SourceFolder As String

' Definitions ---------------------------
SourceFolder = "D:\Accounting\"
NumRow = 100
NumCol = 8
Set TargetRange = [MasterSheet!A1]
' ---------------------------------------

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set colFolders_1 = New Collection
colFolders_1.Add SourceFolder
On Error GoTo FolderNotFound
Set FS_Folders = FS.GetFolder(SourceFolder)
On Error GoTo 0
Set FS_Files = FS_Folders.Files
For Each k In FS_Files
GoSub CheckFileName
Next

Start:
'------
Set colFolders_2 = colFolders_1
Set colFolders_1 = New Collection
For Each i In colFolders_2
Set FS_Folders = FS.GetFolder(i)
Set FS_subFolders = FS_Folders.SubFolders
For Each j In FS_subFolders
Set FS_Folders = FS.GetFolder(j.Path)
colFolders_1.Add j.Path
Set FS_Files = FS_Folders.Files
DoEvents
For Each k In FS_Files
GoSub CheckFileName
Next k
Next j
Next i
If colFolders_1.Count 0 Then
GoTo Start
End If

Exit_Sub:
ThisWorkbook.Save
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub

CheckFileName:
If InStr(1, k.Name, "Source") And Right(k, 4) = ".xls" Then
h = h + 1
Set SourceFile = xlApp.Workbooks.Open(k)
Set SourceRange =
SourceFile.Worksheets("CASH").Range("A1:H100")
For n = 1 To NumRow
For m = 1 To NumCol
TargetRange(n + NumRow * (h - 1), m) = SourceRange(n,
m)
Next
Next
SourceFile.Close
End If
Return

FolderNotFound:
MsgBox "Err. " & Err.Number & " - " & _
Err.Description & vbCrLf & vbLf & _
"Folder: " & UCase(SourceFolder) & _
" -- Not Found."
Resume Exit_Sub

End Sub
============================================

Bruno


Thank you, Bruno. I will try this when I return to work Thursday.

Roy