![根据单元格值将特定工作表从已关闭的工作簿复制或添加到活动工作簿](https://linux22.com/image/1585585/%E6%A0%B9%E6%8D%AE%E5%8D%95%E5%85%83%E6%A0%BC%E5%80%BC%E5%B0%86%E7%89%B9%E5%AE%9A%E5%B7%A5%E4%BD%9C%E8%A1%A8%E4%BB%8E%E5%B7%B2%E5%85%B3%E9%97%AD%E7%9A%84%E5%B7%A5%E4%BD%9C%E7%B0%BF%E5%A4%8D%E5%88%B6%E6%88%96%E6%B7%BB%E5%8A%A0%E5%88%B0%E6%B4%BB%E5%8A%A8%E5%B7%A5%E4%BD%9C%E7%B0%BF.png)
我有每个欧盟国家的原始 CSV 数据,我运行宏来格式化它、进行数据透视等。所有 Excel 文件都以国家代码开头,即:AT 报告 201901、FR 报告 201901 等。
我有另一个 Excel 工作簿,保存在网络驱动器上,称为 VATCONTROLS,其中包含每个国家/地区的工作表,例如 AT、FR、BE、DE 等。
我正在寻找一个宏,它将查看活动工作簿名称的前两位数字,然后从关闭的 VATControls 工作簿中复制/粘贴相应的工作表并将其添加到活动工作簿中。
我该怎么做?这只是代码的一部分。Newsheet 是另一部分代码的工作表。
Dim excel As excel.Application
Dim wsGET As String
Dim wb As excel.Workbook
Dim sht As excel.Worksheet
NewSheet.Activate
Range("A1").Activate
Range("A1") = ActiveWorkbook.Name
Range("B1").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],2)"
wsGET = ActiveSheet.Range("b1")
Set wb = Workbooks.Open("C:\Users\extosldva\documents\vatcontrols.xlsx")
Set sht = wsGET
sht.Activate
sht.Range("A1:A3").Copy
sht.Range("B1:B3").PasteSpecial Paste:=xlPasteValues
For Each Sheet In ActiveWorkbook.Worksheets
If Sheet.Name = wsGET Then
Sheet.Activate
End If
Next
If Not targetSheetFound Then
Set Sheet = Sheets.Add
Sheet.Name = targetSheetName
End If
我尝试了很多方法,并将来自不同来源的一些示例代码片段组合在一起,得到了不同的结果。代码很乱,需要清理,因为它不一致,但我希望这部分能正常工作,我担心我混淆了几种方法来实现一个目标。
澄清一下:我想从已关闭的工作簿中复制或添加整个工作表,其中工作表的名称与单元格 b1 中的值匹配,并将其添加到活动工作簿中的新工作表上。后面的代码部分{Set sht = wb.wsGET}
只是为了看看该部分是否有效。
答案1
@Dennis 以下宏向 Z.active 工作簿添加新工作表并从 vatcontrol 工作簿复制国家增值税工作表
Sub Macro2()
Dim excel As excel.Application
Dim wsGET As String
Dim wb As excel.Workbook
Dim sht As excel.Worksheet
Dim ActvWB As String
Dim targetSheetFound As String
ActvWB = ActiveWorkbook.Name
Sheets.Add After:=Sheets(Sheets.Count)
Range("A1").Activate
Range("A1") = ActiveWorkbook.Name
Range("B1").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],2)"
wsGET = ActiveSheet.Range("B1")
Set wb = Workbooks.Open("C:\Users\extosldva\documents\vatcontrols.xlsx")
targetSheetFound = "Not Found"
For Each Sheet In ActiveWorkbook.Worksheets
If Sheet.Name = wsGET Then
targetSheetFound = "Found"
Sheets(wsGET).Copy After:=Workbooks(ActvWB).Sheets(Workbooks(ActvWB).Sheets.Count)
wb.Close
Exit For
End If
Next
Workbooks(ActvWB).Activate
If targetSheetFound = "Not Found" Then
Sheets.Add After:=Sheets(Sheets.Count)
Sheet.Name = wsGET
End If
Worksheets(wsGET).Activate
MsgBox "done"
End Sub