VBA EXCEL批量平衡复制数据-Excel教程

日常工作中经常会为了汇总多个工作薄，多个工作表的数据选择复制粘贴数据点击到手痛吗？现在分享一下本人使用vba自动平衡复制数据，希望给职场伙伴们一些帮助，

前期准备工作（包括相关工具或所使用的原料等）

需要汇总的数据工作表（需要汇总的数据一致）启用EXCEL的开发工具选项卡

详细的操作方法或具体步骤

按照下图整理需要统计的来源文件夹(当前文档目录下的文件夹），工作薄名，工作表名，目标文件夹(当前文档目录下的文件夹），目标工作薄，工作表，对应返回数据（可以为空），是否更新，

亲！格式不一样也可以哦，需要微调代码啊！

启用开发工具选项卡；

1，点击选项，2，点击自定义功能区，3，勾选开发工具

设置控件；

1，插入命令控件；

2，修改控件名称及显示名；

进入VBA编程界面；复制以下代码到编辑窗口

Private Sub 查询更新数据_Click()

config=vbYesNo + vbQuestion + vbDefaultButton1

ans=MsgBox("你确认更新数据吗？", config, "提示")

If ans=vbYes Then

Dim cnn As Object, rs As Object, SQL$, i&, A&, B&, C&, D&, E&, sFile$

Dim wb As Object, ws As Object

Dim wb1 As Object, ws1 As Object

'取得当前工作表的最后行列

C=ActiveSheet.UsedRange.Rows.Count

E=ActiveSheet.UsedRange.Columns.Count

'创建需要更新工作表的循环数据

For D=2 To C

'来源文件夹

sFile1=ActiveSheet.UsedRange.Cells(D, 1).Text

'来源工作薄

sFile2=ActiveSheet.UsedRange.Cells(D, 2).Text

'来源工作表

sFile3=ActiveSheet.UsedRange.Cells(D, 3).Text

'目标文件夹

sFile4=ActiveSheet.UsedRange.Cells(D, 4).Text

'目标工作薄

sFile5=ActiveSheet.UsedRange.Cells(D, 5).Text

'目标工作表

sFile6=ActiveSheet.UsedRange.Cells(D, 6).Text

'对应返回数据

sFile7=ActiveSheet.UsedRange.Cells(D, 7).Text

'是否更新

sFile8=ActiveSheet.UsedRange.Cells(D, 8).Text

'来源路径

If sFile1="" Then

sFile9=ThisWorkbook.Path & "\" & sFile2 & ".xlsx"

Else

sFile9=ThisWorkbook.Path & "\" & sFile1 & "\" & sFile2 & ".xlsx"

End If

'目标路由

If sFile4="" Then

sFile10=ThisWorkbook.Path & "\" & sFile5 & ".xlsx"

Else

sFile10=ThisWorkbook.Path & "\" & sFile4 & "\" & sFile5 & ".xlsx"

End If

'判断是否查询

If sFile8="是" Then

Cells(1, 11)="正在更新：" & sFile2 & sFile3

'锁定工作薄焦点

Application.ScreenUpdating=False

Application.ShowWindowsInTaskbar=False

'打开来源工作薄,工作表

Set wb=Workbooks.Open(sFile9, False, False)

'打开目标工作薄,工作表

Set wb1=Workbooks.Open(sFile10, False, False)

'返回数据及更新时间

Cells(D, 9)=Now()

'设置平行复制起止行数

For A=1 To 95

'设置平行复制起止列数

For B=1 To 30

'设置对应关系

wb1.Worksheets(sFile6).Cells(A, B)=wb.Worksheets(sFile3).Cells(A, B).Value

Next

Next

wb.Close Savechanges:=True

wb1.Close Savechanges:=True

'解除工作薄焦点

Application.ShowWindowsInTaskbar=True

Application.ScreenUpdating=True

Cells(1, 11)="更新完成！"

End If

Next

MsgBox "更新完成！", vbInformation

If ans=vbNo Then

Exit Sub

End If

End If

End Sub

提示：用户定义类型未定义异常处理办法

处理办法：点击工具-引用-勾选

提示：点击发送OUTLOOK安全提示

处理办法：点击文件-选项-信任中心-信任中心设置-编程访问-勾选从不向我发出可以活动警告

提示：编程访问无法勾选显示灰色时

处理办法：控制面板-用户帐号-点击用户帐号-更改用户账户控制设置-调到从不通知，重启电脑，调整完毕OUTLOOK设置可以再调整回来。

注意事项

实例文档下载地址：http://pan.baidu.com/s/1geszsyB经验内容仅供参考，如果您需解决具体问题(尤其法律、医学等领域)，建议您详细咨询相关领域专业人士。作者声明：本教程系本人依照真实经历原创，未经许可，谢绝转载。