[マクロ]VBAで複数のブックの中のデータを別のベックの１つのシートにまとめる

こんにちは
同じフォルダ内のブック1,2,3,4,5......の[インボイス]というシートの中の色付けているタイトルの下の各データを保存先ブックの指定した場所にコピー貼り付けをしたいのです。

保存先のフォーマットはそのまま維持していただきたいのです。

No.3 ベストアンサー 回答者： Qchan1962 回答日時： 2020/03/22 15:12

推察で回答するのは良くないと思いますが

補足もつかないし、捨てられているのだと思います。が、、、
推察、インボイスが書かれた複数のBookが同じフォルダにあり
そのまとめをフォーマットに従い入力したい。（本来すべての情報を入力してPDFで良いと思う）
例：フォーマットシートの12行は、Book1に書かれている情報、（行間が広いので）

手順
フォーマットファイルを選択
データファイルのフォルダを選択

条件
フォーマットシートは、フォーマットBookのインデックス1にあるものとします。
フォーマットはそのままなので、処理後デスクトップに別名で保存します。
その他、エラーなどの処理は行っていません。
コードの説明は割愛します。
もし、検証する時は、デモファイル（環境）で

エラー、不具合など不明な点があれば、補足してください。。

Option Explicit
'ソートのためのAPI読み出し宣言
Declare PtrSafe Function StrCmpLogicalW Lib "SHLWAPI.DLL" _
　　　　(ByVal lpStr1 As String, ByVal lpStr2 As String) As Long
Sub bubble_sort_API(ByRef StrArr() As String) 'ソートのためのAPI
Dim i As Long, j As Long
Dim tmp As String
　　For i = LBound(StrArr) To UBound(StrArr)
　　　　For j = i To UBound(StrArr)
　　　　　　If StrCmpLogicalW(StrConv(StrArr(i), vbUnicode), StrConv(StrArr(j), vbUnicode)) > 0 Then
　　　　　　　　tmp = StrArr(i)
　　　　　　　　StrArr(i) = StrArr(j)
　　　　　　　　StrArr(j) = tmp
　　　　　　End If
　　　　Next j
　　Next i
End Sub

Sub invoice_AG()
　　Dim i As Long, ix As Long
　　Dim FormatFileName As String, TrgSht_Name As String
　　Dim Folder_path As String
　　Dim FmtFile As Workbook, Sht As Worksheet
　　Dim trgBook As String, FileType As String
　　Dim CpDataA, CpDataD, CpDataE, CpDataG
　　Dim FileName() As String, SaveFilePath As String

　　Application.ScreenUpdating = False
　　'フォーマットファイル
　　FormatFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?", Title:="フォーマットファイルを選択")
　　If FormatFileName <> "False" Then
　　　　Set FmtFile = Workbooks.Open(FormatFileName)
　　Else
　　　　Exit Sub
　　End If
　　'開いたブックに対象のシート名シートがあるか確認
　　TrgSht_Name = "インボイス"　　　　　　'対象のシート名
　　'ダイアログで対象のファイルがあるフォルダをユーザーが選択
　　With Application.FileDialog(msoFileDialogFolderPicker)
　　　　.Title = "対象のフォルダを選択してください"
　　　　If .Show = True Then
　　　　　　Folder_path = .SelectedItems(1)
　　　　End If
　　End With
　　If Folder_path <> "" Then
　　　　FileType = "\*.xls*"
　　　　trgBook = Dir(Folder_path & FileType)
　　　　'---ファイルパス取得 start
　　　　Do
　　　　　　ReDim Preserve FileName(i)
　　　　　　FileName(i) = trgBook
　　　　　　i = i + 1
　　　　　　trgBook = Dir()
　　　　Loop Until trgBook = ""
　　　　'---ファイルパス取得 stop
　　　　Call bubble_sort_API(FileName())　　'ソート呼び出し
　　　　ReDim CpDataA(UBound(FileName)), CpDataD(UBound(FileName))
　　　　ReDim CpDataE(UBound(FileName)), CpDataG(UBound(FileName))
　　　　For ix = 0 To UBound(FileName)
　　　　　　With Workbooks.Open(Folder_path & "\" & FileName(ix))
　　　　　　　　For Each Sht In Worksheets　　　　'開いたブックに対象のシート名があるか確認
　　　　　　　　　　If Sht.Name = TrgSht_Name Then
　　　　　　　　　　　　For i = 3 To Sht.Cells(Rows.Count, 1).End(xlUp).Row
　　　　　　　　　　　　　　CpDataA(ix) = CpDataA(ix) & Sht.Cells(i, 1).Value & vbCrLf
　　　　　　　　　　　　　　CpDataD(ix) = CpDataD(ix) & Sht.Cells(i, 4).Value & vbCrLf
　　　　　　　　　　　　　　CpDataE(ix) = CpDataE(ix) & Sht.Cells(i, 5).Value & vbCrLf
　　　　　　　　　　　　　　CpDataG(ix) = CpDataG(ix) & Sht.Cells(i, 7).Value & vbCrLf
　　　　　　　　　　　　Next
　　　　　　　　　　　　Exit For
　　　　　　　　　　End If
　　　　　　　　Next
　　　　　　　　.Saved = True
　　　　　　　　.Close
　　　　　　End With
　　　　Next
　　　　With FmtFile.Sheets(1)
　　　　　　For i = 0 To UBound(FileName)
　　　　　　　　.Cells(i + 12, 3) = CpDataA(i)
　　　　　　　　.Cells(i + 12, 5) = CpDataD(i)
　　　　　　　　.Cells(i + 12, 6) = CpDataE(i)
　　　　　　　　.Cells(i + 12, 7) = CpDataG(i)
　　　　　　Next
　　　　End With
　　　　'ファイルパス指定
　　　　SaveFilePath = CreateObject("WScript.Shell").SpecialFolders("desktop") _
　　　　　　　　& "\" & "invoice_" & Format(Now, "yyyymmddhhmm") & ".xlsx"
　　　　'ファイル保存(別名）
　　　　FmtFile.SaveAs FileName:=SaveFilePath, FileFormat:=xlOpenXMLWorkbook
　　　　FmtFile.Close
　　End If
　　Application.ScreenUpdating = True
End Sub

No.2 回答者： iothes00 回答日時： 2020/03/17 10:45

どちらにボタンを配置するかによりますが

gyo=20
for i=3 to 6
workbooks("先.xls").activesheet.range("C"&gyo)=range("A"&i)
workbooks("先.xls").activesheet.range("E"&gyo)=range("D"&i)
workbooks("先.xls").activesheet.range("F"&gyo)=range("E"&i)
workbooks("先.xls").activesheet.range("G&gyo)=range("G"&i)
gyo=gyo+5
next

リスト側のコードです

わからないのであれば説明が長くなるので無理かと思います

No.1 回答者： めぐみん_ 回答日時： 2020/03/13 18:44

どのようにデータを纏めるのか、読み込むＢｏｏｋに順番があるのかについて不明な感じがします。

１つのＢｏｏｋの1つのＳｈｅｅｔのデータ１行を結合セル１塊に貼り付けていったら、かなりの行数になりそうですし。（それで構わないのか否か）
Ｂｏｏｋ毎の仕切りはなくただ続けて貼り付けてよいのかも不明。
画像を添付する際には『完成形』にしておいてくれた方がわかりやすいのでは？