Home |
Search |
Today's Posts |
#1
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
|
|||
|
|||
Quote:
Thank you, Bruno. I will try this when I return to work Thursday. Roy |
#5
|
|||
|
|||
Quote:
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
|
|||
|
|||
Quote:
SourceFile.Worksheets("CASH").Range ("A1:H100") It gives the error: "Object doesn't support this property or method" |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
|
|||
|
|||
Quote:
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
|
|||
|
|||
Quote:
|
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
import multiple text files into single sheet separate column | Excel Programming | |||
Combining multiple worksheets into a single master sheet | Excel Programming | |||
Copy Range From Multiple Worksheets to a Single Worksheet | Excel Discussion (Misc queries) | |||
macro: copy multiple workbooks to multiple tabs in single book | Excel Programming | |||
opening multiple .txt files from multiple folders | Excel Discussion (Misc queries) |