質問

I have multiple excel files that are structured identically and are in a folder.

Each excel files data starts at d4 (multiple rows of data but all rows start on the subsequent d)

I need a macro to take the data from all the separate excel files in the folder and create a single new excel file of all the data from the separate excel files, structured like the following.

1.) Data from excel file one starts at a1 in the rollup file

2.) Data from excel file two appended underneath the data from the first excel file in the rollup file

3.) Repeat for all the excel files in the folder.

Thanks

Edit I found this (I am sorry I don't remember where, I do remember it was not working) I know very little about excel and vba (I mostly I work in php), I feel I am asking a lot with out being able to offer much help of my own toward getting what I need, I apologize for this.

I made two simple excel files and added a row of data in each and ran the macro in a excel file called Rollup. I think the problem with this code is that it works in that in the Rollup excel file the cursor moves to the appropriate row as if it appended both files but there is no data showing up.

Sub extract()
Dim a, b, c, d, n, x As Integer
Dim f As String
Cells(2, 1).Select
f = Dir("C:\" & "*.xls")
Do While Len(f) > 0
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
n = n + 1
Loop
x = Cells(Rows.Count, 1).End(xlUp).Row
d = 2
For a = 2 To x
Cells(d, 2) = Cells(a, 1)
For c = 1 To 20
b = 1
Cells(1, 1) = "='c:\[" & Cells(a, 1) & "]sheet1'!" & Chr(b + 64) & c
If Cells(1, 1) = "0" Then
Exit For
Else
For b = 3 To 6
Cells(d, b) = "='c:\[" & Cells(a, 1) & "]sheet1'!" & Chr(b + 64) & c
Next b
End If
d = d + 1
Next c
d = d + 1
Next a
End Sub
役に立ちましたか?

解決

For a simple Rollup the following works, for more complicated need go here: http://msdn.microsoft.com/en-us/library/office/cc837974%28v=office.12%29.aspx

Sub test()
  Dim myFile As String, sh As Worksheet, myRange As Range
  Const MyPath = "C:\My path\" ' to be modified
  Workbooks.Add 1 ' Add a new workbook
  Set sh = ActiveWorkbook.ActiveSheet
  myFile = Dir(MyPath & "*.xls")
  Do While myFile <> ""
    Workbooks.Open MyPath & myFile
    Rows(1).Copy sh.Rows(1)
    Set myRange = ActiveSheet.UsedRange
    Set myRange = myRange.Offset(4).Resize(myRange.Rows.Count - 1) '(4) is how many  rows to ignore befor coping data
    myRange.Copy sh.Range("A65").End(xlUp).Offset(1)
    Workbooks(myFile).Close False
    myFile = Dir
  Loop
End Sub
ライセンス: CC-BY-SA帰属
所属していません StackOverflow
scroll top