Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
365 views
in Technique[技术] by (71.8m points)

vba - Merging multiple workbooks into single sheet in current workbook

I need VBA code to select multiple workbooks by browsing the files and then merge all those into 1 sheet of current workbook.

All multiple workbooks having only 1 sheet

headers is same for all workbooks so header is constant

Merging should not get any empty rows while filling workbook by workbook

No repetition of headers when merging.

When 1st workbook merging is done, 2nd workbook data should be merged in the same sheet of current workbook exactly next row of the merged 1st workbook data ends which means no empty rows or gaps

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

First, This will not paste any headers. Since they are all the same, just move the headers to the excel that will store the consolidation. (No need for a macro to do this since it only needs to happen once).

Second, in the code you need to change "SHEETNAME?" to the name of the sheet on your main book that will store the consolidation. (2 instances, do not remove quotes)

Third, I am assuming there is no blanks in Column A which is what determines how far down to copy. If you expect blanks in Column A, this needs to be amended to reflect a column that is least likely to have blanks.

Lastly, I am copying from Column A to Z. Change the "Z" to the last column in your file that contains data.

Given the quality of (or lack of) your question, this is more than you bargained for :)
Happy Editing.

Option Explicit

Sub Consolidation()

Dim CurrentBook As Workbook
Dim WS As Worksheet
Set WS = ThisWorkbook.Sheets("SHEETNAME?")
Dim IndvFiles As FileDialog
Dim FileIdx As Long
Dim i As Integer, x As Integer

Set IndvFiles = Application.FileDialog(msoFileDialogOpen)
With IndvFiles
    .AllowMultiSelect = True
    .Title = "Multi-select target data files:"
    .ButtonName = ""
    .Filters.Clear
    .Filters.Add ".xlsx files", "*.xlsx"
    .Show
End With

Application.DisplayAlerts = False
Application.ScreenUpdating = False

For FileIdx = 1 To IndvFiles.SelectedItems.Count
    Set CurrentBook = Workbooks.Open(IndvFiles.SelectedItems(FileIdx))
    For Each Sheet In CurrentBook.Sheets
        Dim LRow1 As Long
        LRow1 = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
        Dim LRow2 As Long
        LRow2 = CurrentBook.ActiveSheet.Range("A" & CurrentBook.ActiveSheet.Rows.Count).End(xlUp).Row

        Dim ImportRange As Range
        Set ImportRange = CurrentBook.ActiveSheet.Range("A2:Z" & LRow2)
        ImportRange.Copy
        WS.Range("A" & LRow1 + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next
    CurrentBook.Close False
Next FileIdx

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

1.4m articles

1.4m replys

5 comments

57.0k users

...