标题:求助各位大佬!excel怎么用VB实现工作簿转移?
只看楼主
七彩爆炸鸡
Rank: 1
等 级:新手上路
帖 子:11
专家分:0
注 册:2022-12-11
结帖率:100%
已结贴  问题点数:20 回复次数:9 
求助各位大佬!excel怎么用VB实现工作簿转移?
有2个excel表格1和2;
现在需要在表格1的sheet2工作簿上做一个按钮;
点击按钮可以将表格2中的的工作簿B移动到表格1里面;
就是图片2中的工作簿移动到图片1上,最后形成图片3的样子;
求各位大神教一下怎么写这段代码。



搜索更多相关主题的帖子: 表格 转移 图片 工作 excel 
2022-12-11 10:40
yuma
Rank: 11Rank: 11Rank: 11Rank: 11
来 自:银河系
等 级:贵宾
威 望:33
帖 子:1883
专家分:2904
注 册:2009-12-22
得分:0 
写过类似的程序,不过我是VB6 / VBS 写的,代码比较长。

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2022-12-11 12:23
七彩爆炸鸡
Rank: 1
等 级:新手上路
帖 子:11
专家分:0
注 册:2022-12-11
得分:0 
回复 2楼 yuma
大神能用VB写给我?
2022-12-11 14:20
mrexcel
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:22
帖 子:125
专家分:480
注 册:2022-11-3
得分:0 
楼主似乎工作簿与工作表概念有些模糊,多看看帮助文件
Private Sub CommandButton1_Click()
Workbooks("工作簿1").Sheets("工作簿B").Move Before:=Workbooks("工作簿3").Sheets("工作簿A")
End Sub
2022-12-11 22:52
mrexcel
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:22
帖 子:125
专家分:480
注 册:2022-11-3
得分:0 
若是这样的命名便可以做到望文生义,暴力直观
Private Sub CommandButton1_Click()
Workbooks("工作簿1").Sheets("表B").Move Before:=Workbooks("工作簿3").Sheets("表A")
End Sub
2022-12-11 22:53
yuma
Rank: 11Rank: 11Rank: 11Rank: 11
来 自:银河系
等 级:贵宾
威 望:33
帖 子:1883
专家分:2904
注 册:2009-12-22
得分:0 
回复 3楼 七彩爆炸鸡
两个EXcel文件中的数据转移?那要先读取内容,再写文件了。

你是要把 A.xlsx文件中的数据,复制到 B.xlsx中去,是这个意思吧?

还是同一个文件中的数据,在文件内转移?

[此贴子已经被作者于2022-12-12 11:41编辑过]


心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2022-12-12 11:16
七彩爆炸鸡
Rank: 1
等 级:新手上路
帖 子:11
专家分:0
注 册:2022-12-11
得分:0 
回复 6楼 yuma
把B.xls的sheet1,移动到A.xls里面
2022-12-12 15:32
mrexcel
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:22
帖 子:125
专家分:480
注 册:2022-11-3
得分:0 
Workbooks("B.xls").Sheets("sheet1").Move Before:=Workbooks("A.xls").Sheets("sheet1")
2022-12-12 16:33
yuma
Rank: 11Rank: 11Rank: 11Rank: 11
来 自:银河系
等 级:贵宾
威 望:33
帖 子:1883
专家分:2904
注 册:2009-12-22
得分:20 
回复 7楼 七彩爆炸鸡
工作表的数据可以复制过去,但工作表格式无法复制。

Private Sub Form_Load()
Dim MyXlsApp, xlSheet1, excel_sheet1

'避免出现:运行时错误91,未设置对象变量或with block变量
Dim wsh
Set wsh = CreateObject("Wscript.Shell")
wsh.run "reg delete HKCU\Software\Microsoft\Office\Excel\Addins /f", 0

'读Excel文件
Set MyXlsApp = CreateObject("Excel.Application")  '打开模板文件
Set excel_sheet1 = MyXlsApp.Workbooks.Open("C:\Users\Admin\Desktop\B.xlsx")
Set excel_sheet2 = MyXlsApp.Workbooks.Open("C:\Users\Admin\Desktop\A.xlsx")
MyXlsApp.Visible = False
excel_sheet1.Worksheets(1).Activate   '设置第1个工作页为活动工作表,数字为几就是第几张表
'excel_sheet1.Worksheets("Sheet1").activate   ' 设置第1个工作页为活动工作表,直接指定表名称
Set xlSheet1 = excel_sheet1.Worksheets(1)
'Set xlSheet1 = excel_sheet1.Worksheets("Sheet1")
excel_sheet2.Worksheets(1).Activate   '设置第1个工作页为活动工作表,数字为几就是第几张表
'excel_sheet2.Worksheets("Sheet1").activate   ' 设置第1个工作页为活动工作表,直接指定表名称
Set xlSheet2 = excel_sheet2.Worksheets(1)
'Set xlSheet2 = excel_sheet2.Worksheets("Sheet1")
rowcount = excel_sheet1.ActiveSheet.UsedRange.Rows.Count
Columnscount = excel_sheet1.ActiveSheet.UsedRange.Columns.Count
If xlSheet1.Cells(1, 1) = "" And rowcount = 1 And Columnscount = 1 Then '写个判断语句,避免没有数据时行数和列数显示为1
MsgBox "sheet1" & "中没有数据"
Else
'MsgBox "sheet1" & "的行数为:" & rowcount & "  列数:" & Columnscount
Dim X, Y, I, J
X = rowcount  'X坐标轴,行数
Y = Columnscount  'Y坐标轴,列数
I = 1
J = 1
For J = 1 To Y + 1
    If J = Y + 1 Then
        J = 1
        I = I + 1
        If I = X + 1 Then
            Exit For
        End If
    End If
    'xlSheet1.Cells(I, J).Select
     xlSheet2.Cells(I, J) = xlSheet1.Cells(I, J)
Next
End If
excel_sheet1.Close (True)
excel_sheet2.Close (True)
MyXlsApp.Quit
Set MyXlsApp = Nothing
End Sub

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2022-12-12 19:32
七彩爆炸鸡
Rank: 1
等 级:新手上路
帖 子:11
专家分:0
注 册:2022-12-11
得分:0 
回复 9楼 yuma
我操,谢谢大佬!!!
2022-12-14 09:00



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-510923-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.233235 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved