☰

根据单元格值将特定工作表从已关闭的工作簿复制或添加到活动工作簿

tag-icon • tag-icon microsoft-excel vba macros
根据单元格值将特定工作表从已关闭的工作簿复制或添加到活动工作簿

我有每个欧盟国家的原始 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

相关内容