VBA EXCEL批量平衡复制数据

在日常任务中，频繁地手动整合多个工作簿和工作表的数据操作是否令您疲惫不堪？现借此分享我运用VBA自动化技巧高效复制数据的经验，期待为同行们带来实质性的便利。

1、 按照下图整理需要统计的来源文件夹(当前文档目录下的文件夹），工作薄名，工作表名，目标文件夹(当前文档目录下的文件夹），目标工作薄，工作表，对应返回数据（可以为空），是否更新，?亲！格式不一样也可以哦，需要微调代码啊！

2、 启用开发工具选项卡；1，点击选项，2，点击自定义功能区，3，勾选开发工具

3、 设置控件；1，插入命令控件；2，修改控件名称及显示名；

4、 ?进入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 SubEnd If?End IfEnd Sub