Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Junior Member
 
Posts: 21
Default Copy range from multiple files in multiple folders to single sheet in master WB

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.

Thanks!
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,522
Default Copy range from multiple files in multiple folders to singlesheet in master WB

On Tuesday, July 17, 2012 1:49:35 PM UTC-5, Royzer wrote:
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.

Thanks!




--
Royzer


Without testing the idea is to have a looping macro
for each f in range("mylistoffilenames"
fileopen
sheets(1).rows("1:100").copy _ destinationfile.cells(rows.count,1).end(xlup)(2)
filecloce
next f
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 74
Default Copy range from multiple files in multiple folders to single sheet in master WB

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


  #4   Report Post  
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
  #5   Report Post  
Junior Member
 
Posts: 21
Default

Quote:
Originally Posted by Royzer View Post
Thank you, Bruno. I will try this when I return to work Thursday.

Roy
Bruno, my apologies for taking so long to try your code. If you do not wish to pursue this after all this time has passed, I understand.

The code on the second line "Dim FS As New FileSystemObject"
is giving me a "user defined type not defined" error:

These two lines under "CheckFileName" are showing in red when I paste the code:

Set SourceRange =

and

TargetRange(n + NumRow * (h - 1), m) = SourceRange(n,
m)




[code]
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 = "S:\Accounting\film"
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


  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 74
Default Copy range from multiple files in multiple folders to single sheet in master WB

Royzer has brought this to us :
Royzer;1603941 Wrote:
Thank you, Bruno. I will try this when I return to work Thursday.

Roy


Bruno, my apologies for taking so long to try your code. If you do not
wish to pursue this after all this time has passed, I understand.

The code on the second line "Dim FS As New FileSystemObject"
is giving me a "user defined type not defined" error:


You need the reference:
MicrosoftScriptingRuntime

These two lines under "CheckFileName" are showing in red when I paste
the code:

Set SourceRange =

Set SourceRange = SourceFile.Worksheets("CASH").Range("A1:H100")
To be written all in one line!

TargetRange(n + NumRow * (h - 1), m) = SourceRange(n,
m)

TargetRange(n + NumRow * (h - 1), m) = SourceRange(n, m)
To be written all in one line!

Bruno


  #7   Report Post  
Junior Member
 
Posts: 21
Default

Quote:
Originally Posted by Bruno Campanini[_2_] View Post
Royzer has brought this to us :
Royzer;1603941 Wrote:
Thank you, Bruno. I will try this when I return to work Thursday.

Roy


Bruno, my apologies for taking so long to try your code. If you do not
wish to pursue this after all this time has passed, I understand.

The code on the second line "Dim FS As New FileSystemObject"
is giving me a "user defined type not defined" error:


You need the reference:
MicrosoftScriptingRuntime

These two lines under "CheckFileName" are showing in red when I paste
the code:

Set SourceRange =

Set SourceRange = SourceFile.Worksheets("CASH").Range("A1:H100")
To be written all in one line!

TargetRange(n + NumRow * (h - 1), m) = SourceRange(n,
m)

TargetRange(n + NumRow * (h - 1), m) = SourceRange(n, m)
To be written all in one line!

Bruno
Thank you for your help, Bruno. I made the changes you suggested and now the code runs until it gets to this line in the CheckFileName section:

SourceFile.Worksheets("CASH").Range ("A1:H100")

It gives the error: "Object doesn't support this property or method"
  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 151
Default Copy range from multiple files in multiple folders to singlesheet in master WB

Hi

As you have already declared the Sourcefile as

Set SourceFile = xlApp.Workbooks.Open(k)

You should only need to use the following:

Set SourceRange = SourceFile.Range("A1:H100")

HTH
Mick.
  #9   Report Post  
Junior Member
 
Posts: 21
Default

Quote:
Originally Posted by Living the Dream View Post
Hi

As you have already declared the Sourcefile as

Set SourceFile = xlApp.Workbooks.Open(k)

You should only need to use the following:

Set SourceRange = SourceFile.Range("A1:H100")

HTH
Mick.

Thanks, Mick. The code ran but I got jammed with notifications from each of the 32 files I was pulling data from asking me if I wanted to save the file before closing. Is there something I can add to avoid that?
  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 151
Default Copy range from multiple files in multiple folders to singlesheet in master WB

You could try the following:

In as much as it is purely asthetic, I prefer to use the following which
keeps everything together in a nice collection rather than address each
line of:

Application This, or Application That, you can use the With statement
and include each point.

You would use the following to turn off.

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.AlertBeforeOverwriting = False
End With

Then use this to reset them when exiting the routine.

With Application
.Calculation = = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.AlertBeforeOverwriting = True
End With


HTH
Mick.


  #11   Report Post  
Junior Member
 
Posts: 21
Default

Quote:
Originally Posted by Living the Dream View Post
You could try the following:

In as much as it is purely asthetic, I prefer to use the following which
keeps everything together in a nice collection rather than address each
line of:

Application This, or Application That, you can use the With statement
and include each point.

You would use the following to turn off.

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.AlertBeforeOverwriting = False
End With

Then use this to reset them when exiting the routine.

With Application
.Calculation = = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.AlertBeforeOverwriting = True
End With


HTH
Mick.
Thanks, Mick. I appreciate the help.
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
import multiple text files into single sheet separate column Jootje Excel Programming 10 February 8th 08 06:09 PM
Combining multiple worksheets into a single master sheet Albert Excel Programming 2 January 11th 08 05:01 PM
Copy Range From Multiple Worksheets to a Single Worksheet Dauntless1 Excel Discussion (Misc queries) 5 August 17th 07 01:59 AM
macro: copy multiple workbooks to multiple tabs in single book Michael Excel Programming 0 July 14th 06 04:53 PM
opening multiple .txt files from multiple folders Corben Excel Discussion (Misc queries) 3 March 16th 06 01:43 AM


All times are GMT +1. The time now is 05:30 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"