精华内容
下载资源
问答
  • VBA合并多个EXCEL表代码 1以下是合并多个EXCEL表为同一个EXCEL表 Sub CombineWorkbooks) Dim FilesToOpen Dim x As Integer On Error GoTo ErrHandler Application.ScreenUpdating = False FilesToOpen = ...
  • VBA 合并多个excel

    2016-04-27 22:53:42
    Sub 汇总() Dim myPath$, myFile$, AK...'找寻下一*.xls文件 Loop Application.ScreenUpdating = True '冻结屏幕,此类语句一般成对使用 MsgBox "汇总完成,请查看!" , 64 , "提示" End Sub
    Sub 汇总()
    
       Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
       Application.ScreenUpdating = False        '冻结屏幕,以防屏幕抖动
       myPath = ThisWorkbook.Path & "\VMS基础信息表(寿险汇总)\"          '把文件路径定义给变量
    
       myFile = Dir(myPath & "*.xlsx")            '依次找寻指定路径中的*.xls文件
       Do While myFile <> ""                     '当指定路径中有文件时进行循环
          If myFile <> ThisWorkbook.Name Then
             Set AK = Workbooks.Open(myPath & myFile)          '打开符合要求的文件
              For i = 1 To AK.Sheets.Count
             If AK.Sheets(i).Name = "附表一之二 纳税主体" Then
             aRow = AK.Sheets(3).Range("b65536").End(xlUp).Row
             tRow = ThisWorkbook.Sheets(1).Range("b65536").End(xlUp).Row + 1
    
                'AK.Sheets(i).Select
             AK.Sheets(3).Range("A8:r" & aRow).Copy ThisWorkbook.Sheets(1).Range("a" & tRow)
             End If
             Next
             Workbooks(myFile).Close False               '关闭源工作簿,并不作修改
          End If
          myFile = Dir                                   '找寻下一个*.xls文件
       Loop
    
       Application.ScreenUpdating = True                 '冻结屏幕,此类语句一般成对使用
       MsgBox "汇总完成,请查看!", 64, "提示"
    
    
    End Sub
    展开全文
  • VBA 合并多个excel文件

    千次阅读 2019-05-22 18:24:58
    VBA 合并多个excel文件 先新建一个文件夹,把要合并的多个excel文件放入这个文件夹,再新建一个excel文件,alt+f11(即右击查看代码),双击宏里的这个sheet文件,在窗口中输入代码 Sub 合并当前目录下所有工作簿的...

    VBA 合并多个excel文件
    先新建一个文件夹,把要合并的多个excel文件放入这个文件夹,再新建一个excel文件,alt+f11(即右击查看代码),双击宏里的这个sheet文件,在窗口中输入代码
    Sub 合并当前目录下所有工作簿的全部工作表()
    Dim MyPath, MyName, AWbName
    Dim Wb As Workbook, WbN As String
    Dim G As Long
    Dim Num As Long
    Dim BOX As String
    Application.ScreenUpdating = False
    MyPath = ActiveWorkbook.Path
    MyName = Dir(MyPath & “” & “*.xls”)
    AWbName = ActiveWorkbook.Name
    Num = 0
    Do While MyName <> “”
    If MyName <> AWbName Then
    Set Wb = Workbooks.Open(MyPath & “” & MyName)
    Num = Num + 1
    With Workbooks(1).ActiveSheet
    .Cells(.Range(“B65536”).End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
    For G = 1 To Sheets.Count
    Wb.Sheets(G).UsedRange.Copy .Cells(.Range(“B65536”).End(xlUp).Row + 1, 1)
    Next
    WbN = WbN & Chr(13) & Wb.Name
    Wb.Close False
    End With
    End If
    MyName = Dir
    Loop
    Range(“B1”).Select
    Application.ScreenUpdating = True
    MsgBox “共合并了” & Num & “个工作薄下的全部工作表。如下:” & Chr(13) & WbN, vbInformation, “提示”
    End Sub

    运行(F5)

    在这里插入图片描述

    在这里插入图片描述

    展开全文
  • 使用VBA合并多个Excel工作簿 例如,需要将多个Excel工作簿中的工作表合并到一个工作簿。这
  • vba合并多个Excel文档

    千次阅读 2019-01-14 17:39:53
    vba合并多个Excel文档 引用自:https://blog.csdn.net/win_turn/article/details/75577465 说明:在引用地址的基础上做了修改,根据公司使用人的需求,把合并sheet页和excel文档揉在了一起。 仅适用于每个...

    vba合并多个Excel文档

    引用自:https://blog.csdn.net/win_turn/article/details/75577465

    说明:在引用地址的基础上做了修改,根据公司使用人的需求,把合并sheet页和excel文档揉在了一起。

    仅适用于每个sheet的第一行是数据头,数据从第二行开始。

    代码:

    Sub 合并工作簿()
        Dim FileOpen
        Dim X As Integer
        Application.ScreenUpdating = False
        Rem
        FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel文件(*.xlsx),*.xlsx,
        Excel 97-2003 工作簿(*.xls),*xls", MultiSelect:=True, Title:="请选择需要合并的工作簿")
        X = 1
        If TypeName(FileOpen) = "Boolean" Then
            MsgBox "未选择任何文件, 退出."
            Exit Sub
        End If
        While X <= UBound(FileOpen)
            Workbooks.Open Filename:=FileOpen(X)
            Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            X = X + 1
        Wend
        Dim J As Integer
        On Error Resume Next
        Sheets(1).Select
        Sheets(1).Name = "汇总"
        Sheets(2).Activate
        Sheets(2).Range("A1").EntireRow.Select
        Selection.Copy Destination:=Sheets(1).Range("A1")
        For J = 2 To Sheets.Count
            Sheets(J).Activate
            c = Sheets(J).Range("IV1").End(xlToLeft).Column
            r = Sheets(J).Range("A65536").End(xlUp).Row
            Sheets(J).Range("A2").Resize(r - 1, c).Select
            Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
        Next
    ExitHandler:
        Application.ScreenUpdating = True
        Exit Sub
    errhadler:
        MsgBox Err.Description
    End Sub
    
    展开全文
  • 使用VBA合并多个EXCEL文件到一个EXCEL文件
    

    有时候我们需要把一大堆的Excel文件合并一个文件,这时候我们可以想到利用VBA来做。

    这涉及到遍历文件夹以及子文件夹,找出所有的文件,并且读取文件把它们的内容合并到同一个Excel文件中去。

    下面的代码可以实现这样的操作。


    Sub MergeData()

        Dim strFileName As String
        Dim strFolder As String
        Dim row As Integer
        Dim col As Integer
        Dim outRow As Integer
        Dim fob As Object
        Dim fFile As file
        Set fso = CreateObject("scripting.filesystemobject")
        '中间变量worksheet
        Dim wsTemp As Worksheet
        '中间变量workbook

        Dim wbTemp As Workbook
        Dim strMergedFilePath As String
        Dim wbMerged As Workbook
        '输出用worksheet变量

        Dim wsMerged As Worksheet
        '输出用地区名
        Dim strOutFolderName As String
        '输出用城市名
        Dim strOutFileName As String
       
        Application.Visible = False
        Application.ScreenUpdating = False
       
        strMergedFilePath = ThisWorkbook.Path & "\"
       
        Set wsMerged = ThisWorkbook.Sheets(2)
       
        wsMerged.Name = "test"
           
        strFolder = Cells(2, 3).Value
       
        If Dir(strFolder, 16) = Empty Then
            MsgBox "Folder not exits!", vbOKOnly
        End If
       
        Dim file() As String
        Dim f As String
        Dim i, k
        i = 2
        k = 1

        ReDim file(1 To 1)

        '获取所有的子文件夹
        f = Dir(strFolder & "\", vbDirectory)
        Do Until f = ""
            If InStr(f, ".") = 0 Then
                k = k + 1
                ReDim Preserve file(1 To k)
                file(k) = f
            End If
            f = Dir
        Loop
       
        On Error Resume Next
       
        outRow = 3
       
        Do While i <= k
       
            strOutFolderName = file(i)
       
            strFileName = Dir(strFolder & "\" & file(i) & "\*.xlsx", vbDirectory)
           
            Do While strFileName <> ""
           
               strOutFileName = strFileName
               Set wbTemp = Workbooks.Open(strFolder & "\" & file(i) & "\" & strFileName)
                     
               Set wsTemp = wbTemp.Sheets("test")
              
              
               If wsTemp Is Nothing Then
               Else
              
                If outRow = 3 Then
                    row = 2
                Else
                    row = 3
                End If
               
               
                Do While wsTemp.Cells(row, 1).Value <> ""
                   
                    If outRow = 3 Then
                        wsMerged.Cells(outRow, 1).Value = "地区"
                        wsMerged.Cells(outRow, 2).Value = "城市"
                    Else
                        wsMerged.Cells(outRow, 1).Value = strOutFolderName
                        wsMerged.Cells(outRow, 2).Value = strOutFileName
                    End If
                       
                    col = 1
                   
                    Do While wsTemp.Cells(row, col).Value <> ""
                   
                       
                        wsMerged.Cells(outRow, col + 2).Value = wsTemp.Cells(row, col).Value
                   
                        col = col + 1
                       
                    Loop

                    row = row + 1
                   
                    outRow = outRow + 1
                   
                Loop
               
               End If
           
               wbTemp.Close
               strFileName = Dir
           
            Loop
           
            i = i + 1
          
        Loop
       
        wsMerged.Activate
        'wbMerged.SaveAs (strMergedFilePath & "MergedData.xlsx")
        Application.Visible = True

    End Sub


    展开全文
  • VBA合并多个Excel文件

    2021-03-03 17:07:16
    程序提示:合并了4个excel文件,并列出了各个excel文件的名称。合并后的数据第1行为空行。 列数为8列。总行数为2981,减去空行即:含数据的行数为2980,恰好为4个原始Excel文件的数据总量。 ..
  • VBA拆分一个excel文件为多个excel文件 合并代码如下 Sub 多表多文件合并为多表一文件() Dim FileArray Dim X As Integer Application.ScreenUpdating = False FileArray = Application.GetOpenFilename...
  • VBA合并多个Excel文档

    千次阅读 2018-06-03 13:55:56
    Sub 合并当前目录下所有工作簿的全部工作表() Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Application.ScreenUpdating = False MyPath = ...
  • 具体操作方法如下:1、把需要合并excel表格文档放到同一文件夹里(注意,文件夹中不要有其他的Excel文件)。2、新建一合并数据.xlsm“文档(文件名称自定义即可,xlsm为启用宏的Excel文件格式)。3、打开“合并...
  • VBA合并多个excel

    2017-12-22 10:55:32
    Sub 合并当前目录下所有工作簿的全部工作表() Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String flag = 0 Application.ScreenUpdating ...
  • 合并多个EXCEL表代码 今天工作时,写一个文档,突然需要将多个excel工作簿合并成一个,于是总结一下,希望有用。 1、合并多个EXCEL表为同一个EXCEL表 Sub CombineWorkbooks() Dim FilesToOpen Dim x As Integer ...
  • 工作原因,需要统计所有单位的帐号信息,但是每个单位的帐号都分散在各自的excel表格里,因此需要把多个execel表格的相同的某个sheet页做合并。 大致步骤拆分,分别搜了下VBA,拼凑了三天搞定,还是有点成就感的 ...
  • 使用VBA合并多个Excel文件

    万次阅读 2012-04-29 13:29:29
     今天一同学突然在Q上问起我如何将多个Excel文件合并到一个Sheet文件中,起初我是想通过编程来实现的,因为之前我用C++实现过一个Excel操作类的封装,也用该类实现过一些自动化工具。但考虑到这本来是个很简单的...
  • 合并sheet页, 合并excel文档, 合并工作表, 合并工作簿合并多个工作表 仅适用于每个sheet的第一行是数据头,数据从第二行开始。excel合并多个sheetApplication.ScreenUpdating = False For j = 1 To Sheets.Count ...
  • '功能:把多个工作簿的第一个工作表合并到一个工作簿的多个工作表,新工作表的名称等于原工作簿的名称 Sub Books2Sheets() '定义对话框变量 Dim fd As FileDialog Set fd = Application.FileDialog...
  • 利用VBA实现多个EXCEL表格合并

    千次阅读 2015-12-28 10:42:07
    工作小作业-多表合并多个excel表格,字段都一样,内容数据不同,利用VBA实现数据合并到一张表格Sub text1() Application.ScreenUpdating = False Dim x As Integer, y As Integer Dim wb As Workbook, wbb As ...
  • 最近捣腾起VBA,通过录制宏,度娘,...效果视频和代码在下方,还有很多可以优化的地方,也欢迎各路大神指点如果不会使用,也欢迎给我留言哦效果如下视频VBA合并多个工作簿https://www.zhihu.com/video/116754003944...
  • 双击打开汇总文件.xls(当然我们也可以随便新建一个excel文档),按ALT+F11打开VBE编辑器,新建一个模块,粘贴如下代码:Option ExplicitSub mergeonexls() '合并多工作簿中指定工作表On Error Resume NextDim x As ...
  • 在网上找EXCEL多文件合并的方法,思路: 一、Linux 或者window+cmder,直接用命令行cat合并EXCEL文件,但是,需要安装辅助东西才能直接处理(也许也不可以,但是,可以用文件格式转换工具转换是可行的,把EXCEL文件...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 441
精华内容 176
关键字:

vba合并多个excel