合并分表，如何只保留一个表头

kykykyky · 发表于 2013-10-17 15:36

合并同一文件夹中工作表，9月份分表文件夹中分表，要求是把这个文件夹中的每个工作薄的第一个表的汇总到一个总表格，只保留一个表头，其余表的表头都不要，只留一个表头，其余的表只把表内容提取合并过来。

蔡明江 · 发表于 2013-10-17 15:47

报表统计.rar (16.24 KB, 下载次数: 20)
Sub 数组法()
   On Error Resume Next
   Dim sh As Worksheet, MyPath$, MyName$, arr, m&
   Set sh = ActiveSheet
   'MyPath = ThisWorkbook.Path & "\"
   MyPath = "D:" & "\9月分表\"

   MyName = Dir(MyPath & "*.xls")
   Application.ScreenUpdating = False
   ActiveSheet.UsedRange.ClearContents
   Do While MyName <> ""
      If MyName <> ThisWorkbook.Name Then
         m = m + 1
         With GetObject(MyPath & MyName)
            If m = 1 Then
                  arr = .Sheets("附件1").UsedRange
                  sh.[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
            Else
                  arr = .Sheets("附件1").UsedRange.Offset(1)
                  sh.[a65536].End(xlUp).Resize(UBound(arr), UBound(arr, 2)) = arr
            End If
            .Close False
         End With
      End If
      MyName = Dir
   Loop
   [a65536].End(xlUp).EntireRow.Delete

For I = Sheets("附件1").Range("A56565").End(3).Row To 3 Step -1
   If Sheets("附件1").Cells(I, 2) Like "" Then Sheets("附件1").Rows(I).Delete
   If Sheets("附件1").Cells(I, 1) Like "*制表人签字*" Then Sheets("附件1").Rows(I).Delete
   If Sheets("附件1").Cells(I, 1) Like "*序号*" Then Sheets("附件1").Rows(I).Delete
   If Sheets("附件1").Cells(I, 2) = "" Then Sheets("附件1").Rows(I).Delete
   Next

蔡明江 · 发表于 2013-10-17 15:50

本帖最后由蔡明江于 2013-10-17 15:53 编辑

将 9月分表放到D盘子文件夹报表统计表也放到D盘不要放到9月分表文件夹中

kykykyky · 发表于 2013-10-17 16:06

能不能不放在D盘，在当前文件夹下怎么实现啊

kykykyky · 发表于 2013-10-17 16:16

这段代码，我实现了把工作薄的表表全合在一个总表中了，但是表头都存在，各位老师帮忙改一下啊
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xls")
i = 0
Do While MyName <> ""
If MyName <> ActiveWorkbook.Name Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
i = i + 1
With Workbooks(1).ActiveSheet
.Cells(.Range("A65536").End(xlUp).Row + 2, 1) = MyName
Wb.Sheets(1).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
Wbn = Wbn & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop

kykykyky · 发表于 2013-10-17 16:40

把在”9月份“这个文件夹中的所有分表，合并到一个总表中，但是只保留一个表头。其余的分表的只要表的内容，而且不要空白行，只要数据区；

zhaogang1960 · 发表于 2013-10-17 16:53

请测试:

Sub Macro1()
Dim MyPath$, MyName$, sh As Worksheet, lr&, m&
Set sh = ActiveSheet
MyPath = ThisWorkbook.Path & ""
MyName = Dir(MyPath & "*.xlsx")
Application.ScreenUpdating = False
Cells.ClearContents
Do While MyName <> ""
m = m + 1
With GetObject(MyPath & MyName)
If m = 1 Then
.Sheets(1).[a1].CurrentRegion.Copy sh.[a1]
Else
lr = .Sheets(1).[a1].CurrentRegion.Rows.Count - 2
If lr > 0 Then .Sheets(1).[a1].CurrentRegion.Offset(2).Resize(lr).Copy sh.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
.Close False
End With
MyName = Dir
Loop
Application.ScreenUpdating = True
End Sub

复制代码

zhaogang1960 · 发表于 2013-10-17 16:54

请看附件

9月分表.rar (254.05 KB, 下载次数: 114)

蔡明江 · 发表于 2013-10-17 16:55

楼主重复发帖

kykykyky · 发表于 2013-10-17 17:43

感谢老师们啊

		自动登录	找回密码
密码			免费注册

[求助] 合并分表，如何只保留一个表头

同一文件夹分表合并，只留一个表头

评分