Question

希望你能帮助我只知道基础知识并且我试图看到有一种简单的方法来重复vba中的过程而不是重新输入。

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

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

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

使用工作表列出所需的所有文件夹，并创建循环以简化代码。您可以在folders列中使用整数变量和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

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

2 个答案: