Using VBA rapid integration of multiple excel files

Experience (a): VBA on how the contents of all files in the same file merge into the same excel file

Question: How do the same multiple integrated into a format excel excel, at first thought that may directly file copy and paste ...... but there are a few hundred less than one thousand, to do so cranky ...

Solution: First of all you want to integrate the excel file in a directory path does not contain the Chinese name, and then create a excel file, right-click to see the code sheet, this time there will be an editor on your screen, you use something like this written in VBA language, and finally click F5 can be run directly

Normal Solution:
open a excel file and copy the contents of want, and then paste it into the integration of the excel file, and repeat this operation.

Using VBA operations:

  1. Open the file using the VBA code is as follows:
    Here Insert Picture Description
    open the file absolute address in brackets

  2. Copy the contents of the selected area:
    Here Insert Picture Description

  3. Copy and paste the contents of the specified file
    Here Insert Picture Description

  4. Using VBA dir function to open the next file, this function will open a file in the file according to certain rules, but specifically what the law is not yet known,
    this function is if this way:
    Here Insert Picture Description
    the first for the first time will enter an absolute address, but behind it is not required

Source as follows:

Sub 合并当前目录下所有工作簿的全部工作表()
'表示当前的过程的名称

'定义对应的变量名称
Dim mypath, myname, awbname
Dim wb As Workbook, wbn As String
Dim g As Long
Dim num As Long
Dim box As String
Dim count As Long
Dim place As Long
Dim temp As Long

'关闭excel的刷新
Application.ScreenUpdating = False

'禁止弹出对话框
Application.DisplayAlerts = False

'得到本文件的相对地址
mypath = ActiveWorkbook.Path

'得到这个文件夹下的某个文件的文件名
myname = Dir(mypath & "\" & "*.xls")

'当前工作的excel的文件名
awbname = ActiveWorkbook.Name

num = 0
place = 3

'如果当前的文件名为空的字符串("")表示已经没有更多的文件了跳出循环
Do While myname <> ""
    '需要的就是下面这个条件,每个文件名都不一样
    If myname <> awbname Then
        '把每一个文件都打开
        Set wb = Workbooks.Open(mypath & "\" & myname)
        num = num + 1
		'计算非空行数量
		count = application.counta(range("c:c"))
		'MsgBox count
		
		wb.Sheets(1).Range("a5", wb.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell)).Copy
		'从a5开始到已用区域最后一个单元格的范围全部复制
        ThisWorkbook.Sheets(1).Cells(ThisWorkbook.Sheets(1).Range("C65536").End(xlUp).Row + 2 , 1).PasteSpecial Paste:=xlValues
		'从c列最后一个有数据的单元格后的空格开始粘贴
		
		'下面开始合并需要的单元格
		temp = count + place - 2
		ThisWorkbook.Sheets(1).Range("A" & place & ":A" & temp).Merge
		ThisWorkbook.Sheets(1).Range("B" & place & ":B" & temp).Merge
		ThisWorkbook.Sheets(1).Range("H" & place & ":H" & temp).Merge
		ThisWorkbook.Sheets(1).Range("I" & place & ":I" & temp).Merge
		
		'对每个队伍重新编号
		ThisWorkbook.Sheets(1).Range("A" & place).Value = num
		place = place + count
        wbn = wbn & Chr(13) & wb.Name
        wb.Close False
		
    End If
myname = Dir
Loop
Range("a1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "共合并了" & num & "个工作薄下的全部工作表。'如下:" & Chr(13) & wbn, vbInformation, "提示"
End Sub
Published 41 original articles · won praise 6 · views 10000 +

Guess you like

Origin blog.csdn.net/qq_42224330/article/details/100063945