复制工作表的代码(在不同工作簿中取相同的工作表,生成新的工作簿)

lzqmsy

求助复制工作表的代码,在一个文件夹内有多个格式相同的文件,欲复制每个文件中相同表名的工作表,生成新的工作簿,销售统计8-1至销售统计8-10是10个源文件,北京销售-8是效果文件(这个效果文件是复制的表名为北京的工作表,新工作簿的表名是日期,即每个表的[B1]单元格),不知能否实现,多谢各位老师!!!(附件在2楼)

lzqmsy

复制工作表.rar (77.5 KB, 下载次数: 6)

2014-9-3 17:21 上传

点击文件名下载附件

lzqmsy

请各位高手留步,也请赵刚版主相助,多谢了!!!

lzqmsy

在线等,请各位老师相助,再次谢谢了!!!

zax010

Sub zz()
    Dim myPath$, myFile$, AK As Workbook, d
    Set d = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    myPath = ThisWorkbook.Path & "\"
    myFile = Dir(myPath & "*.xls")
    Do While myFile <> ""
        If myFile <> ThisWorkbook.Name Then
            Set AK = Workbooks.Open(myPath & myFile)
            For Each sh In AK.Sheets
                If Not d.exists(sh.Name) Then
                    d(sh.Name) = ""
                    sh.Copy
                    ActiveWorkbook.Sheets(1).Name = Format(sh.[b1].Value, "m-d;@")
                    ActiveWorkbook.SaveAs (ThisWorkbook.Path & "\城市分表\" & sh.Name & "销售明细表-8" & ".xls")
                Else
                    Set wb = Workbooks(sh.Name & "销售明细表-8" & ".xls")
                    sh.Copy before:=wb.Sheets(1)
                    wb.Sheets(1).Name = Format(sh.[b1].Value, "m-d;@")
                End If
            Next
            AK.Close False
        End If
        myFile = Dir
    Loop
    For Each wb In Workbooks
        If wb.Name <> ThisWorkbook.Name Then
            wb.Close True
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "分表完成。"
End Sub

zax010

>>>>>>>>>>>>>>>
复制工作表.rar (84.85 KB, 下载次数: 19)

2014-9-4 10:45 上传

点击文件名下载附件

lzqmsy

zax010 发表于 2014-9-4 10:45
>>>>>>>>>>>>>>>

太谢谢您了,做的太好了,献花再次感谢

lzqmsy

zax010 发表于 2014-9-4 10:40
Sub zz()
    Dim myPath$, myFile$, AK As Workbook, d
    Set d = CreateObject("Scripting.Dictionar ...

老师,您好!我修改了一句代码,原因是打开新生成的文件时提示格式不对,在2007中点确定能打开,在2003中就打不开,修改后就可以正常打开了,也没有提示了,但我不知道是不是还有其他影响,所以再次请教您,添麻烦了.
修改前:ActiveWorkbook.SaveAs (ThisWorkbook.Path & "\城市分表\" & sh.Name & "销售明细表-8" & ".xls")
修改后:ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\城市分表\" & sh.Name & "销售明细表-8" & ".xls", FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
等待您的指教

zax010

lzqmsy 发表于 2014-9-4 15:27
老师,您好!我修改了一句代码,原因是打开新生成的文件时提示格式不对,在2007中点确定能打开,在2003中就打不 ...

应该没有别的影响。
我用的是Excel03，其默认文件存储格式应该是FileFormat:=xlExcel8，故只是写了文件名，其他都省略了，我测试也都正常。
按你改动的用吧。

lzqmsy

zax010 发表于 2014-9-4 16:51
应该没有别的影响。
我用的是Excel03，其默认文件存储格式应该是FileFormat:=xlExcel8，故只是写了文件 ...

谢谢您的再次回复,用的很正常,多谢了!!!