[已解决]excle已经合并,但是数据,格式都不正确,该怎么改正?

louzilc · 发表于 2012-9-7 17:21

各位大侠,老师:
   通过搜索，我用hb_new.xlsm基本实现了同文件夹下,多表对应sheet的合并，但是，数据和格式不正确，怎么都只是有三行。宏，看得不是特别懂，尽管语句挺少的。应该怎么样改正才可以实现这样一个功能。

   宏的功能是：将当前目录下的的其他.xlsx文件，对应的同名的sheet 合并。宏名是 :HEBING

      谢谢大家了。

最佳答案

月排行榜 / 总排行榜

cbg2008

2012-9-7 17:45

Sub HEBING()
Application.ScreenUpdating = False
For Each ST In Sheets
ST.UsedRange.Offset(1, 0).ClearContents
Next
MyPath = ThisWorkbook.Path
MYFILE = Dir(MyPath & "\*.xlsx")
Do Until MYFILE = ""
If MYFILE <> ThisWorkbook.Name Then
Set FS = Workbooks.Open(MyPath & "" & MYFILE)
For I = 1 To ThisWorkbook.Worksheets.Count
With FS.Sheets(I)
.Range("A2:V" & .Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Sheets(I).Range("A65536").End(3)(2) 'Range("A65536")前面少个点
End With
Next
FS.Close
End If
MYFILE = Dir
Loop
Application.ScreenUpdating = True
End Sub

复制代码

跳转到最佳答案楼层

louzilc · 发表于 2012-9-7 17:23

期待老师们的解答,谢谢啦.

cbg2008 · 发表于 2012-9-7 17:45

这个最佳答案由 cbg2008 给出，感谢 cbg2008 的回答。

单击隐藏图章

Sub HEBING()
Application.ScreenUpdating = False
For Each ST In Sheets
ST.UsedRange.Offset(1, 0).ClearContents
Next
MyPath = ThisWorkbook.Path
MYFILE = Dir(MyPath & "\*.xlsx")
Do Until MYFILE = ""
If MYFILE <> ThisWorkbook.Name Then
Set FS = Workbooks.Open(MyPath & "" & MYFILE)
For I = 1 To ThisWorkbook.Worksheets.Count
With FS.Sheets(I)
.Range("A2:V" & .Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Sheets(I).Range("A65536").End(3)(2) 'Range("A65536")前面少个点
End With
Next
FS.Close
End If
MYFILE = Dir
Loop
Application.ScreenUpdating = True
End Sub

复制代码

louzilc · 发表于 2012-9-10 08:27

问题已经解决,谢谢大家啦,十分感谢!

MCBA2012 · 发表于 2012-9-11 23:08

学习了,好东西一定好好研究,分类收藏,然后再适时调用

louzilc · 发表于 2012-9-12 09:24

感谢大家回复,问题已经解决.

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