私はマスターワークブックを構築することを見ていますすべてのコストセンターのデータの月次ダンプを受け取ります。このデータは、ワークブック内の多数のワークシートに入力され、分割してサービスヘッドに送信する必要があります。サービスヘッドは、シート名の最初の4文字に基づいて選択されたワークシートを受け取ります（ただし、これはやがて変更される可能性があります）。
たとえば、1234x、1234y、5678a、5678bは、それぞれ2枚のシートを持つ1234および5678という名前の2つの新しいブックを作成します。
私はさまざまなフォーラムからいくつかのコードを作成しましたサービスヘッドの4文字コードを定義するハードコードされた配列を介して機能するマクロを作成し、一連の新しいワークブックを作成します。そして、それはうまくいくようです。
しかしながら.. リンクがコピーされるデータシートにリンクが残るように、コピーされるファイルの配列と共にソースデータ（ "データ"と呼ばれる）内にメインデータダンプシートを含める必要もあります。データシートを個別にコピーする行を作成した場合、新しいブックは引き続きソースファイルを参照しますが、サービスヘッドにはアクセスできません。
主な質問は次のとおりです。「データ」タブをSheets（CopyNames）に追加するにはどうすればよいですか。コードをコピーして、配列内の他のすべてのファイルにコピーし、リンクをそのまま保持します。
2番目の質問は、私がそれが最初であると決めたらワークシートの2文字は、サービスヘッドに関連するシートを定義します。コードのスプリット/ミッドラインを調整するにはどうすればよいですか。
コードをよりエレガントにするためのその他のヒント感謝します（サービスヘッドコードの非常に長いリストがある可能性があり、ループするループのリストを作成するより良い方法があると確信しています）
Sub Copy_Sheets()
Dim strNames As String, strWSName As String
Dim arrNames, CopyNames
Dim wbAct As Workbook
Dim i As Long
Dim arrlist As Object
Set arrlist = CreateObject("system.collections.arraylist")
arrlist.Add "1234"
arrlist.Add "5678"
Set wbAct = ActiveWorkbook
For Each Item In arrlist
For i = 1 To Sheets.Count
strNames = strNames & "," & Sheets(i).Name
Next i
arrNames = Split(Mid(strNames, 2), ",")
"strWSName =("1234")
strWSName = Item
Application.ScreenUpdating = False
CopyNames = Filter(arrNames, strWSName, True, vbTextCompare)
If UBound(CopyNames) > -1 Then
Sheets(CopyNames).Copy
ActiveWorkbook.SaveAs Filename:=strWSName & " " & Format(Now, "dd-mmm-yy h-mm-ss")
ActiveWorkbook.Close
wbAct.Activate
Else
MsgBox "No sheets found: " & strWSName
End If
Next Item
Application.ScreenUpdating = True
End Sub
回答：
回答№1は0Option Explicit
Sub CopySheets()
With ThisWorkbook
Dim SheetIndex As Long
Dim ValidSheetNames() As String
ReDim ValidSheetNames(1 To .Worksheets.Count)
" Build a 1 dimensional array called ValidSheetNames, which contains every sheet in the master workbook other than DEDICATEDSHEET. "
Dim ws As Worksheet
For Each ws In .Worksheets
If ws.Name <> "DEDICATEDSHEET" Then
SheetIndex = SheetIndex + 1
ValidSheetNames(SheetIndex) = ws.Name
End If
Next ws
ReDim Preserve ValidSheetNames(1 To SheetIndex)
" Read all ServiceCodes into a 1-dimensional array "
Dim ServiceHeadCodes As Variant
ServiceHeadCodes = Application.Transpose(.Worksheets("DEDICATEDSHEET").Range("CCLIST[CC]").Value2)
Dim CodeIndex As Long
" Now loop through each ServiceHeadCode "
For CodeIndex = LBound(ServiceHeadCodes) To UBound(ServiceHeadCodes)
" Put all sheet names which contain the current ServiceHeadCode into an array called SheetsToCopy "
Dim SheetsToCopy() As String
SheetsToCopy = Filter(ValidSheetNames, ServiceHeadCodes(CodeIndex), True, vbTextCompare)
" Check if SheetToCopy now contains any sheet names at all. "
If UBound(SheetsToCopy) > -1 Then
" Add the name of the Data sheet to the end of the array "
ReDim Preserve SheetsToCopy(LBound(SheetsToCopy) To (UBound(SheetsToCopy) + 1))
SheetsToCopy(UBound(SheetsToCopy)) = "Data"
Dim OutputWorkbook As Workbook
Set OutputWorkbook = Application.Workbooks.Add
" Copy all sheets which are in SheetToCopy array to newly created OutputWorkbook "
.Worksheets(SheetsToCopy).Copy OutputWorkbook.Worksheets(1)
" Delete the default Sheet1, which should be at the end as copied sheets were inserted before it. "
" But suppress the Are you sure you want to delete this sheet.. message. "
Application.DisplayAlerts = False
OutputWorkbook.Worksheets(OutputWorkbook.Worksheets.Count).Delete
Application.DisplayAlerts = True
" Re-enable alerts, as we want to see any other dialogue boxes/messages
" Not providing a full directory path below means OutputWorkbook will be saved wherever Thisworkbook is saved."
OutputWorkbook.SaveAs Filename:=ServiceHeadCodes(CodeIndex) & " " & Format(Now, "dd-mmm-yy h-mm-ss") & ".xlsx", FileFormat:=51
OutputWorkbook.Close
Else
MsgBox "No sheets found: " & ServiceHeadCodes(CodeIndex)
End If
Next CodeIndex
End With
End Sub
未テストでモバイルで書かれていますが、フォーマットが悪いためごめんなさい。
このアプローチは、すべてのサービスを保存することを提案しますExcelテーブルの命名法で参照される専用シート上の1列のExcelテーブルのヘッドコード（新しいサービスヘッドコードごとにArrayList.Addより簡単な場合があります）。
コードはマスターブック（ "thisworkbook"）に格納されていると仮定しますが、これは正しくない可能性があります。
serviceheadcodesテーブルを変更できますSheetsToCopyが最初の2、3、またはX文字によって決定されることを後で決定した場合、またはスプレッドシート自体に直接追加するか、left $（）関数を使用して配列自体を変更できます。
それがうまくいくか、あなたにいくつかのアイデアを与えることを願っています。
編集： これは私のシートとテーブルのレイアウトです（これはあなたのものと一致すると思います）。
そして、これは上記のコードが私のコンピューター上で私に与えるものです。
