打开将多个文件中的数据复制到一个工作表中-快捷方式

Question

希望您能帮到我

基本上我需要将多个文件中的数据复制到一个文件中。我要复制的文件都在不同的子文件夹中。

这就是我所拥有的，但正如您所看到的，我只是复制代码并更改文件位置以完成有效的任务，但只是想知道是否更简单，因为有多个文件位于不同的位置。

Sub Disconnections()

'
' Disconnections Macro
'
SheetName = Format(Date, "dd-mm-yyyy")
On Error GoTo AddNew
Sheets(SheetName).Activate
Exit Sub
AddNew:
Sheets.Add , Worksheets(Worksheets.Count)
ActiveSheet.Name = SheetName '
    Workbooks.Open Filename:= _
        "C:\My Documents\Customer 1\Customer 1 Data List"
    Sheets("Disconnections").Select
    Sheets("Disconnections").AutoFilterMode = False
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Windows("Disconnections.xlsm").Activate
    ActiveSheet.Paste
    Range("A1048576").End(xlUp).Offset(1, 0).Select
Selection.End(xlDown).Select
Range("A1048576").End(xlUp).Offset(1, 0).Select
Windows("Connection List - Abel & Cole.xls").Activate
ActiveWindow.Close
Application.DisplayAlerts = False
   Workbooks.Open Filename:= _
    "C:\My Documents\Customer 2\Customer 2 Data List"
Sheets("Disconnections").Select
Sheets("Disconnections").AutoFilterMode = False
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Windows("Disconnections.xlsm").Activate
ActiveSheet.Paste
Range("A1048576").End(xlUp).Offset(1, 0).Select
Selection.End(xlDown).Select
Range("A1048576").End(xlUp).Offset(1, 0).Select
Windows("Connection List.xls").Activate
ActiveWindow.Close
Application.DisplayAlerts = False

End Sub

这可能吗？

谢谢

***更新****

我现在收到运行时错误 438 - 对象不支持此属性或方法。我想我遗漏了一些东西或错误地编辑了数据。你能告诉我有什么问题吗

Sub Disconnections()

'
' Disconnections Macro
'
SheetName = Format(Date, "dd-mm-yyyy")
On Error GoTo AddNew
Sheets(SheetName).Activate
Exit Sub

AddNew:
Sheets.Add , Worksheets(Worksheets.Count)
ActiveSheet.Name = SheetName '

Dim x As Integer
Dim numFolders As Integer
numFolders =       WorksheetFunction.CountA(ThisWorkbook.Sheets("Sheet2").Column(1))

For x = 1 To numFolders
Dim i As Integer, NoCustomers
NoCustomers = 3
For i = 1 To NoCustomers
    Workbooks.Open Filename:= _
        "C:\My Documents\Customer 1 \ Customer 1 Data List
    Sheets("Disconnections").Select
    Sheets("Disconnections").AutoFilterMode = False
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Windows("Disconnections.xlsm").Activate
    ActiveSheet.Paste
   Selection.End(xlDown).Select
   Windows("Customer 1 Data List.xls").Activate
    ActiveWindow.Close
    Application.DisplayAlerts = False

Next i
Next x

End Sub

Answer 1

只需使用这样的循环：

Dim i As Integer, NoCustomers

NoCustomers=99
For i = 1 To NoCustomers
    Workbooks.Open Filename:= "C:\My Documents\Customer "&i&"\Customer "&i&" Data List"
    'do copy-paste-thing
Next i

此外，您可以去掉那些看起来像这样的“选择”行：

Range("A1048576").End(xlUp).Offset(1, 0).Select

Answer 2

使用工作表列出您想要的所有文件夹并创建循环以简化代码。您可以在文件夹列中使用整数变量和 CountA 来获取您需要使用的循环数。如果你不明白，我可以在一个小时内写一个例子。

编辑：

这个例子是这样的。

Dim x As Integer
Dim numFolders As Integer

numFolders = WorksheetFunction.CountA(ThisWorkbook.Sheets("sheetWithFoldersList").Column(1))

For x = 1 to numFolders
'enter the code for looping'
Next x