VBA　閉じている他のブックのシートをコピーし、その後セルの結合の解除・データ集約・再結合を自動で行いたい

実現したいこと

①　閉じている他のブックからシートをコピーして、開いているExcelの末尾に追加
②　下図のような入力データの編集をするために、
セルの結合の解除⇒複数行のデータを1つのセルに集約⇒1行複数列で結合し、行の高さを自動調整

以上の作業を行えないかと考えています。
可能であれば、Sheet1にボタン等を設置して①を行い、②を行う際はリストからシートを選択して実行するといった流れで行いたいのですが、可能でしょうか…？

発生している問題・分からないこと

①について
様々なサイトを調べてみたのですが、下記のようにコード内でコピー元とコピー先のファイル名を指定しているものしか見つけられず、今回の作業ではコピー元のファイル名が異なる為、私の調べ方では対処の仕方がわかりませんでした。

Sub CopySheetFromClosedWB()
Application.ScreenUpdating = False

    Set closedBook = Workbooks.Open("example.xlsm")
    closedBook.Sheets("Sheet1").Copy Before:=ThisWorkbook.Sheets(1)
    closedBook.Close SaveChanges:=False

Application.ScreenUpdating = True
End Sub

②について
以下のコードを呼び出して対処していこうと思っていますが、行の高さを自動調整することができません。

Sub 結合解除()
    Range("A1:A30").UnMerge  
End Sub

Sub 集約()
Dim c As Long
Dim rng As Range
Dim s As String
For c = 1 To Cells(1, Columns.Count).End(xlToLeft).Column Step 2
Set rng = Cells(1, c).Resize(Cells(Rows.Count, c).End(xlUp).Row)
If rng.Count = 1 Then
s = rng.Value
Else
s = Join(WorksheetFunction.Transpose(rng), vbLf)
End If
Cells(1, c + 1).Value = s
Next
End Sub

Sub 調整()
Rows(1).AutoFit 
End Sub


Sub 結合()
    Range("A1:C1").Merge True  
End Sub

試したこと・調べたこと

teratailやGoogle等で検索した
ソースコードを自分なりに変更した
知人に聞いた
その他

上記の詳細・結果

セルの結合がされている場合、高さの自動調整ができないとの記載があった為、②について呼び出し順を変更してみたりしましたが、うまく動きませんでした。

いつも分かりづらい説明かつ、丸投げのようになってしまって恐縮なのですが、お力添えをいただけますと嬉しく思います。
よろしくお願いいたします。

hatena19

2024/03/12 06:28

① > 今回の作業ではコピー元のファイル名が異なる為コピー元のファイル名をどのように指定する想定ですか。シート上にファイル名を記述しておくとか、ファイル選択ダイアログを開いて選択するとか、それを明確にしてください。

hatena19

2024/03/12 06:50

②にかんして図ではSheet1 Sheet1(2) というように処理毎にシートを追加していってますが、実際もそのようにしたいのですが、それともSheet1で完結させてもいいのですか。

shibakoppe

2024/03/12 07:02

>>hatena19様コピー元のファイル名については、命名規則を設けていないため、ダイアログを開いて選択する形にしたいと思います。 ②につきまして、コピー元のシート名がそのまま入る形にできればと思います。いつもお手数をおかけしてしまい、申し訳ございません。

hatena19

2024/03/12 07:57

① ＞ダイアログを開いて選択する形にしたいと思います。「VBA ファイル選択ダイアログ」でググればサンプルコードはいろいろ見つかると思います。

行動規範の内容に同意します

回答1件

ベストアンサー

①に関して

ダイアログを開いて選択する形にしたいと思います。

「VBA ファイル選択ダイアログ」でググればサンプルコードはいろいろ見つかると思います。

②に関して
下記でどうでしょう。

js
1Sub Sample()
2    Dim Rng As Range
3    Set Rng = Range("A1").CurrentRegion.Columns(1)
4    Rng.UnMerge
5
6    Dim s As String
7    If Rng.Cells.Count = 1 Then
8        s = Rng.Value
9    Else
10        s = Join(WorksheetFunction.Transpose(Rng), vbLf)
11    End If
12    
13    Rng.Cells(1).Value = s
14    Rng.Rows(1).AutoFit
15    Rng.Cells(1).Resize(, 3).Merge True
16    Rng.Resize(, 3).Offset(1).Clear
17End Sub