VBAでわかる方教えて下さい。 １つのbookに30シートほどデータが入ってます。 それらを全て縦に統合したいのですが中々うまくいきません。 データの内容は簡単に言えば見積書みたいなものです。 表なども入ってます。 ネットで色々調べて試してみましたが、これだ。と思えるものが作れませんでした。 ネット上で出てきた作り方では合わない箇所が多々あり、 ①全てのシートのA列が空欄になってます。これも空欄のままコピーしたいです。 ②貼り付けるシート間に1行空白を入れたいです。 ③結合されてるセルはそのままのサイズでコピーしたいです。 ④ボタンプッシュでプログラムを起動したいのですが、プッシュしたら新しいシートが統合データみたいな名前入りで作成され、そこに縦に統合したいです。 いくつか試してみたコードを貼ります。 Sub Test() Dim i As Long, ad As Integer, r As Long Sheets(1).Cells.Clear For i = 2 To ActiveWorkbook.Sheets.Count Sheets(i).UsedRange.Copy r = Sheets(1).UsedRange.Rows.Count If i = 2 Then ad = 0 Else ad = 3 Cells(r, 1).Offset(ad).Select ActiveSheet.Paste Next Sheets(1).Columns.AutoFit End Sub これが一番希望に近かったのですが、A列の空欄が潰されて本来B列からのデータがA列から入力されてました。 表や背景色などはそのままでしたが、結合セルが１セルになってました。 (例えばBCDセルを結合して文字が入ってたのにBだけになり、Eに入ってた文字がスライドしてCに入るみたいな。) あと、手動で空シートを作成して開発→VB→実行をしないといけない。 ボタンを作るとコピペ後もボタンが残ったままになる為。 その前に作ったものは↓ Sub シート統合() 'シート「統合データ」を削除 On Error Resume Next Application.DisplayAlerts = False Worksheets("統合データ").Delete Application.DisplayAlerts = True 'シート「統合データ」を追加してシートの先頭へ移動 Set addedSheet = Worksheets.Add(Before:=Worksheets(1)) addedSheet.Name = "統合データ" 'すべてのシートで処理 Dim i As Long Dim w As Worksheet For i = 2 To Worksheets.Count Set w = Worksheets(i) 'ただし、シート名が「統合シート」を除く If w.Name <> "統合シート" Then Dim From_Max_Row As Long From_Max_Row = w.Range("b" & Rows.Count).End(xlUp).Row Dim To_Max_Row As Long To_Max_Row = Worksheets("統合シート").Range("b" & Rows.Count).End(xlUp).Row + 1 w.Rows("1:" & From_Max_Row).Copy Worksheets("統合シート").Range("b" & To_Max_Row) End If Next Worksheets("統合シート").Rows(1).Delete End Sub これはデータがそもそもうまく移りませんでした。 シートが作られてそこに書かれていくのは良かったのですが、データがおかしかった上にシート間に空白行が入れれなかったのでごちゃごちゃになってました。 知識がないもので色々試行錯誤してみましたがわからなかったので、わかる方どうかよろしくお願い致します。