セルの値に基づいて、閉じたブックから特定のシートをアクティブなブックにコピーまたは追加します。

セルの値に基づいて、閉じたブックから特定のシートをアクティブなブックにコピーまたは追加します。

私は EU 各国の生の CSV データを持っており、それに対してマクロを実行してフォーマットしたり、ピボットを作成したりしています。Excel ファイルはすべて国コードで始まります (例: AT レポート 201901、FR レポート 201901 など)。

ネットワーク ドライブに保存された VATCONTROLS という別の Excel ブックがあり、国ごとにシート (AT、FR、BE、DE など) があります。

アクティブなワークブック名​​の最初の 2 桁を調べ、閉じた 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

私はいろいろ試し、さまざまなソースからのいくつかのサンプル コード スニペットを組み合わせて、さまざまな結果を得ました。コードは乱雑で、一貫性がないため整理する必要がありますが、この部分を機能させたいので、1 つの目標を達成するために複数の方法を混在させているのではないかと心配しています。

明確に言うと、閉じたブックからシート全体をコピーまたは追加します。シート名はセル b1 の値と一致し、アクティブなブックの新しいシートに追加します。コードの後の部分は、{Set sht = wb.wsGET}その部分が機能するかどうかを確認するためだけのものでした。

答え1

@Dennis次のマクロは、Z.activeワークブックに新しいシートを追加し、vatcontrolワークブックからcountry vatシートをコピーします。

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

関連情報