☰

根據儲存格值將特定工作表從關閉的工作簿複製或新增至活動工作簿

tag-icon • tag-icon microsoft-excel vba macros
根據儲存格值將特定工作表從關閉的工作簿複製或新增至活動工作簿

我有每個歐盟國家的原始CSV 數據，我在其上運行巨集來格式化它、製作數據透視表等。 。

我有另一個 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 woorkbook 複製國家/地區增值稅工作表

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

相關內容