VBA将excel中的多个工作表sheet合成一个工作表，多个工作簿的多个工作表合并为一个工作簿

69 阅读 0 评论 46 点赞

我是靠谱客的博主默默板凳，最近开发中收集的这篇文章主要介绍VBA将excel中的多个工作表sheet合成一个工作表，多个工作簿的多个工作表合并为一个工作簿，觉得挺不错的，现在分享给大家，希望可以做个参考。

概述

1 将excel中的多个工作表sheet合成一个工作表

工作表合成前：

在这里插入图片描述
工作表合成后：

在这里插入图片描述

**第一步：**在文件中新建一个工作表sheet，用来存放合成后的数据，如图所示：

在这里插入图片描述

第二步：点击“开发工具—>查看代码”命令，如图所示：

在这里插入图片描述

第三步在sheet1（sheet2）中输入代码，如图所示：

在这里插入图片描述

这个程序文件名的长度可能会有问题

给前面加序号 windows 1.txt 修改为 1.bat 双击执行

@echo off
setlocal enabledelayedexpansion
for /f "tokens=*" %%i in ('dir/b/a-d') do (
set /a cnt+=1
set fn=00!cnt!_!
ren "%%i" "!fn:~-3!%%i")
pause

具体代码如下：

Private Sub sheets()
Application.ScreenUpdating = False
'合并工作表
Dim asheet As Worksheet
Set asheet = ActiveSheet

Dim sum As Long
sum = 1


'循环遍历每个工作表   Workbooks(1).sheets.Count  这个数目不一定 可能 -1 -2 -3
For j = 1 To Workbooks(1).sheets.Count 
    '判断遍历的工作表是否是合并后的那张工作表
   If Workbooks(1).sheets(j).Name <> ActiveSheet.Name Then
        '如果不是,定义所遍历的工作表数据行数
       
        '把所遍历的工作表中的数据复制到合并的那张工作表中
       Workbooks(1).sheets(j).Select
       Workbooks(1).sheets(j).UsedRange.Select
       Selection.Copy
       
       asheet.Select
       asheet.Cells(sum, 1).Select
       asheet.Paste
       
       sum = sum + Workbooks(1).sheets(j).Range("A65536").End(xlUp).Row + 1
       
       
   End If

Next j

'删除多余的表头
Dim i As Integer, Cons As Integer
    '定义合并后工作表的数据行数
   Cons = Range("A65536").End(xlUp).Row
   '通过上面方法合并工作表后会存在第一行没有数据,所以删除第一行
   Range("A1").EntireRow.Delete
   '从后往前遍历合并后的工作表第一列数据
    For i = Cons To 3 Step -1
        '判断是否是需要删除的字段名，“序号”是表格中当前字段开头的名字
        If Range("A" & i) = "单据号" Then
            '如果是，执行删除
            Range("A" & i).EntireRow.Delete
        End If
    Next i

Range("B1").Select

Application.ScreenUpdating = True

MsgBox "当前工作簿下的全部工作表已经合并完毕！", vbInformation, "提示"

End Sub

第五步：点击“运行”即可。或者“点击运行—>运行子过程/用户窗体”。

在这里插入图片描述

这样工作表就可以合在一起了！

2 多个工作簿的多个工作表合并为一个工作簿

Sub CombineWorkbooks()
    Dim strFileName As String
    Dim wb As Workbook
    Dim ws As Object
 
    '包含工作簿的文件夹,可根据实际修改
    Const strFileDir As String = "D:示例数据记录"
 
    Application.ScreenUpdating = False
 
    Set wb = Workbooks.Add(xlWorksheet)
    strFileName = Dir(strFileDir & "*.xls*")
 
    Do While strFileName <> vbNullString
        Dim wbOrig As Workbook
        Set wbOrig = Workbooks.Open(Filename:=strFileDir & strFileName, ReadOnly:=True)
        strFileName = Left(strFileName, 2)
 
        For Each ws In wbOrig.Sheets
            ws.Copy After:=wb.Sheets(wb.Sheets.Count)

            wb.Sheets(wb.Sheets.Count).Name = strFileName & ws.Index

        Next
 
        wbOrig.Close SaveChanges:=False
 
        strFileName = Dir
 
    Loop
 
    Application.DisplayAlerts = False
    wb.Sheets(1).Delete
    Application.DisplayAlerts = True
 
    Application.ScreenUpdating = True
 
    Set wb = Nothing
 
End Sub

转载地址：

将excel中的多个工作表sheet合成一个工作表_猫哥，你好的博客-CSDN博客_多个sheet合并成一个表

在Excel里如何将多个工作簿合并到一个工作簿中 - 走看看