合并多个工作簿并将文件名写入

zongheng20114 · 发表于 2015-11-14 17:24

想要将多个工作簿里面的“sheet1"工作表合并成一个工作簿，并且将文件名写入到合并后的工作簿，请问怎么操作

zax010 · 发表于 2015-11-14 20:51

Sub zz()
Dim f$, p$, a, s
Application.ScreenUpdating = False
Sheet1.UsedRange.Offset(1).ClearContents
p = ThisWorkbook.Path & "\"
f = Dir(p & "*.xls")
Do While Len(f)
      If f <> ThisWorkbook.Name Then
         With GetObject(p & f)
            a = .Sheets(1).Range("A2:G" & .Sheets(1).[a65536].End(3).Row)
            s = Split(f, ".")(0)
            .Close False
         End With
         With Sheet1
         .Range("A" & .[a65536].End(3).Row + 1).Resize(UBound(a), UBound(a, 2)) = a
         .Range("H" & .[h65536].End(3).Row + 1).Resize(UBound(a)) = s
         End With
      End If
      f = Dir
Loop
Application.ScreenUpdating = True
End Sub

zax010 · 发表于 2015-11-14 20:53

>>>>>>>>>>>>>>>>>>>>>>>

合并工作簿.rar (23.29 KB, 下载次数: 305)

zongheng20114 · 发表于 2015-11-16 17:31

zax010 发表于 2015-11-14 20:53
>>>>>>>>>>>>>>>>>>>>>>>

谢谢您，您的方法解决了我的问题
现在有一个新的问题，有空请看看附件

zax010 · 发表于 2015-11-16 18:30

zongheng20114 发表于 2015-11-16 17:31
谢谢您，您的方法解决了我的问题
现在有一个新的问题，有空请看看附件

Sub zz()
Dim f$, p$, a, s
Application.ScreenUpdating = False
Sheet1.UsedRange.Offset(1).ClearContents
p = ThisWorkbook.Path & "\"
f = Dir(p & "*.xls")
Do While Len(f)
      If f <> ThisWorkbook.Name Then
         With GetObject(p & f)
            a = .Sheets(1).Range("A5:G" & .Sheets(1).[c65536].End(3).Row)
            s = Split(f, ".")(0)
            .Close False
         End With
         With Sheet1
            .Range("A" & [c65536].End(3).Row + 1).Resize(UBound(a), UBound(a, 2)) = a
            .Range("H" & .[h65536].End(3).Row + 1).Resize(UBound(a)) = s
         End With
      End If
      f = Dir
Loop
Application.ScreenUpdating = True
End Sub

zax010 · 发表于 2015-11-16 18:32

zongheng20114 发表于 2015-11-16 17:31
谢谢您，您的方法解决了我的问题
现在有一个新的问题，有空请看看附件

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

合并工作簿2.rar (24.61 KB, 下载次数: 190)

cqcbc · 发表于 2015-11-17 07:10

此方法通用，收藏备用。

zongheng20114 · 发表于 2015-11-17 08:37

zax010 发表于 2015-11-16 18:32
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

谢谢你我将北京对账单又稍微改了下，最大行号不是gu，请问现在怎么获取最大行号

zax010 · 发表于 2015-11-17 09:46

zongheng20114 发表于 2015-11-17 08:37
谢谢你我将北京对账单又稍微改了下，最大行号不是gu，请问现在怎么获取最大行号

>>>>>>>>>>>>>>>>>>>>

合并工作簿3.rar (24.79 KB, 下载次数: 533)

zongheng20114 · 发表于 2015-11-17 10:10

zax010 发表于 2015-11-17 09:46
>>>>>>>>>>>>>>>>>>>>

问题解决了
非常感谢

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

[求助] 合并多个工作簿并将文件名写入

评分

评分

评分