VBA script to consolidate multiple excel sheets into one sheet

问题

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

EDIT: 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

回答1:

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

来源：https://stackoverflow.com/questions/23157296/vba-script-to-consolidate-multiple-excel-sheets-into-one-sheet

标签

vba

excel