excel - 将多个工作表复制到不同的工作簿中
问题描述
我想让工作簿 1 中的 VBA 进入指定文件夹,打开其中的三个工作簿,然后将每个工作簿中的数据(文件夹中的每个工作簿只有一张带数据的工作表)复制到工作簿 1 中。
我环顾四周,找到了很多复印表的信息;如果我有工作簿名称和选项卡名称,我可以进入文件夹并复制数据,但每次加载新工作簿时(每月),这些都会改变。
Sub OpenWorkbook1()
'Open workbook
Workbooks.Open "P:\FSD\SUPPORT SERVICES\File Load\190731_CO.xls"
'Copy
Workbooks("190731_CO.xls").Worksheets("190731_CO").Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'Paste
Workbooks("Dual Sub.xlsm").Worksheets("CO").Range("A2").PasteSpecial
Paste:=xlPasteValues
Application.CutCopyMode = False
Workbooks("190731_CO.xls").Close SaveChanges:=False
End Sub
上面的代码没问题,但我希望每个月都能打开工作簿,并且数字(在本例中为 190731)会每月更改为随机数。我需要从 3 个工作簿中提取数据,上面只显示了我从一个工作簿中收集数据。
解决方案
根据我从描述中收集到的信息,问题如下。
目的是将仅包含这三个工作簿的指定文件夹中三个工作簿的第一个工作表的内容复制到已知工作簿中,以最后一个下划线后面的字母命名的工作表。
这实际上不是一个问题,而是三个问题:找到工作簿、从名称中导出正确的工作表和复制内容。
您已经处理了最后一个问题,但不是很通用。评论中链接的答案可以进一步帮助您。但是,由于您只关心值,因此我建议您通过数组进行复制。
Private Sub CopyValues(ByVal sourceRange As Excel.Range, ByVal targetRange As Excel.Range)
Dim copyArray as Variant
copyArray = sourceRange.Value
targetRange.Value = copyArray
End Sub
要获取目标工作表的名称,可以使用 VBA atring 函数;特别是InstrRev
Right
并且Split
可能有用。我将留给您找出定义函数的方法Private Function TargetSheetName(ByVal sourceWorkbookName As String)
。
使用此信息,您可以执行以下操作。
Private Sub CopyFirstSheet(ByVal sourceWorkbook As Excel.Workbook, ByVal targetWorkbook As Excel.Workbook)
Dim sourceRange As Excel.Range
Set sourceRange = CopyRange(sourceWorkbook.Worksheets(1)
Dim targetSheetName As String
targetSheetName = TargetSheetName(targetWorkbook.Name)
Dim targetRange As Excel.Range
Set targetRange = targetWorkbook.Worksheets(targetSheetName).Range("A2")
End Sub
这Private Function CopyRange(ByVal sourceWorksheet As Excle.WorkSheet) As Excel.Range
是一个函数,描述了如何确定给定源工作表的复制范围。
最后,还有寻找源工作簿的问题。在评论中,建议使用Dir
. 但是,我想建议一种更具可读性的方法。除非您在 Mac 上工作,否则您可以参考 Tools->Refreences 下的库 _Microsoft Scripting Runtime`。这使您可以访问Scripting.FileSystemObject。您可以按如下方式使用它。
Private Sub CopyFromFolder(ByVal sourcePath As String, ByVal targetWorkbook As Excel.Workbook)
Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
Dim file As Scripting.File
For Each file in fso.GetFolder(path).Files
Dim sourceWorkbook As Excel.Workbook
Set sourceWorkbook = Application.Workbooks.Open path & file.Name
CopyFirstSheet sourceWorkbook, targetWorkbook
sourceWorkbook.Close SaveChanges:=False
Next
End Sub
这假定文件夹中只有三个工作簿。否则,将需要更多的逻辑。
我希望这对特定问题以及如何将此类问题拆分为可以在单独的过程或功能中处理的较小问题有所帮助。
推荐阅读
- flutter - Flutter 项目不接受 BoxDecoration 颜色
- .net-core - 使用多个 appsettings 文件在 CreateHostBuilder 方法中配置 Serilog
- android - 基本清单缺少 android:icon。您需要使用不同的包名称,因为“com.example”受到限制
- javascript - 无法通过代理对象访问类方法
- wordpress - 在存档页面中使用 ajax 加载变体项目后出现 Woocommerce 错误
- logging - 使用客户端 api 获取 kubelet 日志
- git - 在脚本中访问 Github 的 TeamCity https 凭据
- java - 下载文件时,GB18030 字符被替换为文件名的空格
- javascript - 如何在 chessboard.js 中的棋盘格上显示标记
- sql - 错误:无法将 '--------_dict.sql' 从 UTF-8 编码到 Windows-1250