复制 - 专家坐堂 - Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

共有1819人关注过本帖树形打印复制链接主题：复制

有点甜

小大 11楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：版主帖子：85326 积分：427815 威望：0 精华：5 注册：2012/10/18 22:13:00

Post By：2019/6/10 12:25:00 [只看该作者]

以下是引用发财在2019/6/10 11:02:00的发言：
Ws.Copy(After:=.Item(.Count))'复制到最后面
如何加地址是复制到指定的工作薄中？

参考4楼

发财

小大 12楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：六尾狐帖子：1470 积分：8981 威望：0 精华：0 注册：2013/10/24 9:12:00

Post By：2019/6/11 8:36:00 [只看该作者]

求求老师你，等紧用！

有点甜

小大 13楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：版主帖子：85326 积分：427815 威望：0 精华：5 注册：2012/10/18 22:13:00

Post By：2019/6/11 9:09:00 [只看该作者]

以下是引用发财在2019/6/11 8:36:00的发言：
求求老师你，等紧用！

上传具体项目，说明你要做到什么效果。

发财

小大 14楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：六尾狐帖子：1470 积分：8981 威望：0 精华：0 注册：2013/10/24 9:12:00

Post By：2019/6/12 17:48:00 [只看该作者]

Sheets("表1").Copy After:=Workbooks("备份簿.xls").Sheets(1)

如何做到该效果

有点甜

小大 15楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：版主帖子：85326 积分：427815 威望：0 精华：5 注册：2012/10/18 22:13:00

Post By：2019/6/12 17:53:00 [只看该作者]

上传具体项目，说明你要做到什么效果。

发财

小大 16楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：六尾狐帖子：1470 积分：8981 威望：0 精华：0 注册：2013/10/24 9:12:00

Post By：2019/6/14 11:38:00 [只看该作者]

用户还可以在不同的工作簿之间进行复制。例如，将当前工作簿中的“工资表”工作表复制到打开的 Book1 工作表中，可以输入以下代码：

Sub 复制工作表至 Book1 中()

Sheets(工资表).Copy After:=Workbooks(Book1).Sheets(1)

End Sub

用在狐表中代码应如何做？

有点甜

小大 17楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：版主帖子：85326 积分：427815 威望：0 精华：5 注册：2012/10/18 22:13:00

Post By：2019/6/14 12:03:00 [只看该作者]

参考

Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open("D:\bbb.xls")

Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1) '指定要复制的工作表
Dim Wb2 As MSExcel.WorkBook = App.WorkBooks.Open("D:\aaa.xls")
With Wb.WorkSheets
Ws.Copy(After:=wb2.worksheets(1))'复制到最后面
End With
Wb.Save
wb2.save
App.Quit

发财

小大 18楼 | 信息 | 搜索 | 邮箱 | 主页 | UC

加好友

发短信

等级：六尾狐帖子：1470 积分：8981 威望：0 精华：0 注册：2013/10/24 9:12:00

Post By：2019/6/14 17:51:00 [只看该作者]

Dim c As Date = vars("cc")
Dim f1 As String = "E:\财务数据汇总\经营审核\" & month(c) & "月份"
Dim f2 As String = f1 & "\汇总.xls"
For m As Integer = 1 To 5
    Dim n As Integer = 1
    Dim App As New MSExcel.Application
    Dim wb2 As MSExcel.WorkBook = App.WorkBooks.Open(f2)
    Dim s As String = wb2.worksheets(1).cells(m,1).value
    For Each file As String In filesys .GetFiles(f1 & "\" & s)
        If file.EndsWith(".xls") OrElse file.EndsWith(".xlsx") Then
            Dim wb As MSExcel.WorkBook = App.WorkBooks.Open(file)
            Dim ws As MSExcel.WorkSheet = wb.WorkSheets("整改通知") '指定要复制的工作表
            With wb.WorkSheets
                ws.Copy(Before:=wb2.worksheets(n))'复制到最后面
            End With
            wb2.worksheets(n).name = ws.cells(2,5).value
            n = n + 1
            app.displayalerts=False
            wb.close
        End If
    Next
    app.displayalerts=False
    wb2.worksheets(wb2.WorkSheets.Count).delete
    wb2.SaveAs(f1 & "\汇总" & "(" & s & ")")
    wb2.close
    App.Quit
Next
messagebox.show("汇总生成!")