Question

我正在寻找一个VBA脚本，将多个Excel工作表合并到一个名为＆＃34; consolidated.xlsx＆＃34;的不同文件夹位置的工作表中。我觉得这是一个相当简单的VBA脚本，但我尝试从网站创建一些，但它没有用。任何帮助，将不胜感激。感谢

编辑：我有这个代码进行整合，但它有点复杂。如何将其集成到您的代码中？＃34;合并部分＆＃34;。我已经编写了用于打开Target工作簿的代码，但不确定循环将如何工作以读取所有可用数据并将它们合并到我的目标工作表中（留下任何空白字段）。也许下面的代码会有所帮助：

Sub test()

Dim m1, Filenamev, Filenamev2 As String
Dim loopvar, i As Integer

m1 = Sheets("Sheet2").Range("c2")
mm1 = Sheets("Sheet2").Range("b2")
loopvar = Sheet2.Cells(1, 5)

Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Clear

Workbooks.Open Filename:=m1, ReadOnly:=True
Sheets("sheet1").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("MultiSheetPaste.xlsm").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
False, Transpose:=False
'Windows("DAta1.xlsx").Activate
Application.DisplayAlerts = False
Workbooks(mm1).Close

i = 1

Do While i <= loopvar - 1

Filenamev = Sheet2.Cells(i + 2, 3)
Filenamev2 = Sheet2.Cells(i + 2, 2)
Workbooks.Open Filename:=Filenamev, ReadOnly:=True
Sheets("sheet1").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("MultiSheetPaste.xlsm").Activate
Range("A1").Select
Selection.End(xlDown).Select
Dim m As String
m = ActiveCell.Row
'MsgBox "m"

Range("a" & m + 1).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Windows("DAta2.xlsx").Activate
Application.DisplayAlerts = False
Workbooks(Filenamev2).Close
i = i + 1

Loop

End Sub

Answer 1

这是一个跳跃点。下面的代码将提示用户选择一个文件[您可以看到启用了多选]，然后迭代该选择。我认为你可以从那里填补空白：

Option Explicit
Sub OpeningFiles()

Dim SelectedFiles As FileDialog
Dim NumFiles As Long, FileIndex As Long
Dim TargetBook As Workbook

'prompt user to select a file or multiple files
Set SelectedFiles = Application.FileDialog(msoFileDialogOpen)
With SelectedFiles
    .AllowMultiSelect = True
    .Title = "Pick the files you'd like to consolidate:"
    .ButtonName = ""
    .Filters.Clear
    .Filters.Add ".xlsx files", "*.xlsx"
    .Show
End With

'check to see if user clicked cancel
If SelectedFiles.SelectedItems.Count = 0 Then Exit Sub

'start the loop over each file
NumFiles = SelectedFiles.SelectedItems.Count
For FileIndex = 1 To NumFiles
    'set a reference to the target workbook
    Set TargetBook = Workbooks.Open(SelectedFiles.SelectedItems(FileIndex))
    'do your consolidating here
    '...
    TargetBook.Close SaveChanges:=False
Next FileIndex

MsgBox ("Consolidation complete!")

End Sub

用于将多个Excel工作表合并到一个工作表中的VBA脚本

1 个答案: