4.7.8 将工作表保存为新工作薄

小沢

求助！


Sub SaveToFile()

    Application.ScreenUpdating = False                  
    Dim folder As String
    folder = ThisWorkbook.Path & "\班级成绩表"
    If Len(Dir(folder, vbDirectory)) = 0 Then MkDir folder  （我不想把被分割后的文件存入新建的“班级成绩表”文件中，有没有一个关于文件夹的VBA语句，把被分割的表与被分割后的表生成在同一文件夹而不新建文件夹？）
    Dim sht As Worksheet
    For Each sht In Worksheets                             
        sht.Copy                                             
        ActiveWorkbook.SaveAs folder & "\" & sht.Name & ".xls"
        ActiveWorkbook.Close
    Next
    Application.ScreenUpdating = True                  
End Sub








该贴已经同步到 小沢的微博

hehex

如果不想建立一个新文件夹的话，直接去掉folder 变量，还有那句if 判断。
即把
    Dim folder As String
    folder = ThisWorkbook.Path & "\班级成绩表"
    If Len(Dir(folder, vbDirectory)) = 0 Then MkDir folder  
   三句话都删除。默认拷贝出来的工作薄文件就是和原文件中相同目录下的。

小沢

我试过了，应用到实际的时候，显示error,
excel提示：“ActiveWorkbook.SaveAs folder & " \" & sht.Name & ".xls"”这语句有错误。

hehex

小沢 发表于 2013-2-19 08:46
我试过了，应用到实际的时候，显示error,
excel提示：“ActiveWorkbook.SaveAs folder & " \" & sht.Name  ...

当然报错了，你已经把folder 给取缔了，还："ActiveWorkbook.SaveAs folder"
改成   ActiveWorkbook.SaveAs  Thisworkbook.path & "\" &  sht.name & ".xls"
确定保存在当前路径下。

小沢

hehex 发表于 2013-2-19 09:37
当然报错了，你已经把folder 给取缔了，还："ActiveWorkbook.SaveAs folder"
改成   ActiveWorkbook.S ...

现在已经实现了在同一文件夹下同时存在分割之前的表格与被分割的表格这一目标。

我还有一个疑问，
如果我把"4.7.8 将工作表存为工作薄"这个被分割的表格name也命名为"版权声明"的话，
那么总表，也就是被分割的表"4.7.8 将工作表存为工作薄"就无法完成`SaveToFile`这个VBA语句。
也就是说，excel表格在"4.7.8 将工作表存为工作薄"与"版权声明"不重名的情况下才能完成表格的分割过程。

根据"4.7.9 快速合并多表数据.zip"里的内容，我想在同一文件夹下合并多组数据。
那么如果想让表格不发生重复的话，每次我都得手动删除一次被单独生成的总表(例子中的表格页：“版权声明”)。
有什么办法能让这个VBA语句从第二个表格开始分割吗？？？？
这样的话，或许会节省很多时间。

万分感谢！！！！！

hehex

小沢 发表于 2013-2-19 17:35
现在已经实现了在同一文件夹下同时存在分割之前的表格与被分割的表格这一目标。

我还有一个疑问，

你的意思是忽略名字叫“版权声明”的工作表？
很简单，在操作该表前加一个if 判断就可以了：
比如上面的例子
For each sht in worksheets
       if sht.name <> "版权声明" then   '加判断条件只有当工作表名称不等于版权声明的时候才执行下面代码
          sht.Copy
           .....        '下面代码略
    end if
   next

小沢

hehex 发表于 2013-2-19 17:43
你的意思是忽略名字叫“版权声明”的工作表？
很简单，在操作该表前加一个if 判断就可以了：
比如上面的 ...

{:soso_e110:}总结了一下，then后面的实在不会写。。。。

Sub SaveToFile()
   
    Application.ScreenUpdating = False
    For Each sht In Worksheets
       If sht.Name <> "版权声明" Then
   
    Dim sht As Worksheet
    For Each sht In Worksheets
        sht.Copy
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sht.Name & ".xls"
        ActiveWorkbook.Close
    Next
    Application.ScreenUpdating = True
End Sub

hehex

小沢 发表于 2013-3-7 15:06
我还有个问题求高手解答：
关于附件中，对AAA表进行数据分类，我按照书中的语句稍微改了一下，但是没有成 ...

参考附件。
书上的例子是为了说明单元格对象的用法，并不具备实际应用的意义。
别怕这本书是一本很好的入门教材，但是并不具备代码移植性。

小沢

刚学的VBA，有没有高手帮个忙？？
谢谢啦！！

hehex

小沢 发表于 2013-2-19 20:43
总结了一下，then后面的实在不会写。。。。

Sub SaveToFile()

首先把你保存工作薄目录下已经存的分割出去的工作薄都删除。只留一个总工作簿包含代码的那个。
然后用下面代码：

Sub SaveToFile()
    Application.ScreenUpdating = False
    Dim sht As Worksheet
    For Each sht In Worksheets
        if sht.name <> "版权声明" then
             sht.Copy
             ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sht.Name & ".xls"
             ActiveWorkbook.Close
        end if
    Next
    Application.ScreenUpdating = True
End Sub
这样运行，分割出来的工作薄就不存在"版权声明.xls"了，明白？