VBA脚本将多个Excel工作表合并为一个工作表 [英] VBA script to consolidate multiple excel sheets into one sheet

问题描述

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

Im looking for a VBA script to consolidate multiple Excel sheets into one sheet in a different folder location with the name "consolidated.xlsx". I feel this is a rather simple VBA script but I tried creating a few from.the web and it didnt work. Any help would be appreciated. Thanks

我有执行合并的这段代码，但是有点复杂.如何将其集成到您的代码合并部分"中.我已经编写了用于打开目标"工作簿的代码，但是不确定该循环如何工作以读取所有可用数据并将其合并到我的目标表中(保留任何空白字段).也许下面的代码会有所帮助:

I have this code that does consolidation, but its a bit complicated. How can I integrate this into your code "Consolidation part". I already wrote the code for opening the Target workbook but not sure how the loop will work to read All the available data and consolidate them into my target sheet (leaving any blank fields). Maybe the code below will help:

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

推荐答案

这是一个起点.下面的代码将提示用户选择一个文件(您可以看到启用了多选)，然后遍历该选择.我认为您可以从那里填写空白:

Here is a jumping off point. The code below will prompt a user to select a file(s) [you can see that multi-select is enabled], then iterate over that selection. I think you'll be able to fill-in the blanks from there:

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

这篇关于VBA脚本将多个Excel工作表合并为一个工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！