結合していないセルの検索？

質問

複数シートから指定の1行を別のシートに行を追加して貼り付けをしたいのですが、コピー元が結合していたり、していなかったりとバラバラなため、貼り付け先がぐちゃぐちゃになってしまいお手上げ状態です。

セルの結合は、行は最大2行ですが、列は1列～6列など添付画像のように統一されていません。

例えば、B3～AC4の中でセルの結合が解除されている場所を検索して、ヒットしたら手動でその部分を結合させるということはできますか？

もしくは他に良い方法はありますか？
ご教示よろしくお願いいたします。

スクリプトは見様見真似で以下のように書きました。

Sub コピー()
Dim sh1 As Worksheet
Dim FoundCell As Range, FirstCell As Range

'「項 目」という文字列を検索
　For i = 1 To Worksheets.Count - 2 '←最大シート数
　Sheets(Sheets(i).Name).Select
　Set FoundCell = Cells.Find(What:="項*目")
　　　If FoundCell Is Nothing Then
　　　　　　MsgBox "見つかりません"
　　　　Exit Sub
　　　　Else
　　　　　　’入力されているセルを右に向かって探す
　　　　Set FirstCell = FoundCell
　　　　Set FoundCell = FoundCell.End(xlToRight)

　　　　 　　'指定の範囲を貼り付け先にコピー
　　 　　　　FoundCell.Resize(2, 25).Copy
　　　　Sheets("SheetA").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
　　　　Application.CutCopyMode = False
　　End If
　Next i
End Sub

回答No.2

dogs_cats · ベストアンサー

各シートのB~AC列のデータをsheetAのA列~AB列にセルの結合を含めたコピーするコードを作成したいのでしたら下記のような方法は如何でしょう。

Sub コピー()
Dim sh1 As Worksheet
Dim FoundCell As Range, FirstCell As Range
Dim MaxRow As Long
Dim CR, PR As Range

'「項 目」という文字列を検索
For i = 1 To Worksheets.Count - 2 '←最大シート数
Sheets(Sheets(i).Name).Select
Set FoundCell = Cells.Find(What:="項*目")
If FoundCell Is Nothing Then
MsgBox "見つかりません"
Exit Sub
Else

'コピー元セル範囲を変数に格納
Set CR = FoundCell.Resize(2, 28)

'sheetA　最終行
MaxRow = Sheets("SheetA").Cells(Rows.Count, 1).End(xlUp).Row

'コピー先セル範囲を変数に格納
Set PR = Sheets("SheetA").Range("A" & MaxRow + 2).Resize(2, 28)

'指定の範囲を貼り付け先にコピー
CR.Copy Destination:=PR
End If
Next i

End Sub

添付画像は赤い罫線は結合をしていないセルの罫線をしめしています。
Copy Destinationは一般的なcopyより高速だといわれています。
注意事項はコピー元とコピー先共に同一セル数でセル範囲を指定する事が必須です。
Range("A1:A5").Copy Range("C1")は可能ですが、Copy Destinationではセル範囲が異なるのでこのような指定は出来ません。

お礼

dogs_cats様　お礼が遅くなってすみません。

セル範囲を変数に格納するのですね。
詳しい解説もしていただいたおかげで理解できて、とても勉強になりました。

No.1の方のお礼にも書きましたが、PDFからExcelに変換するソフトを変えたら、セルのフォーマット？がシンプルになって結合も簡単になり、dogs_cats様に教えていただいた方法でばっちり結果を得られました。
ありがとうございました。

ちなみに、PDFからExcelに変換するソフトは、最初に「瞬間PDF変換8」を使用して、最終的には「Wondershare PDF Converter」を使用しました。

本当にありがとうございました！

回答No.1

Prome_Lin

セルが結合されている場合の処理を考えられてはどうでしょうか？

例えば、「A1 」セルが結合されている複数のセルの１つだとします。

すると、

If Range("A1").MergeCells Then （もちろん、Cells(1, 1)・・・で可）
End If

で、判定ができます。

そこで、

If Range("A1").MergeCells Then
a = Range("A1").Value
End If

などとして、いったん変数に格納するのはどうでしょう？

そして、

If Range("A1"),MergeCells Then
a = Range("A1").Value
Worksheets(2).Cells(x, y).Value = a
Else
この部分は、使っておられるプログラムのまま
End If

などとすれば、良いのではないでしょうか？

お礼

Rome_Lin様　お礼が遅くなってすみません。
教えていただいた方法でウンウン悩みながら試行錯誤していました。

セルが1つにまとめて結合されていないものは条件分岐で結合していない方に進みたいのですが、行だけは結合していたりするので、判定は「結合状態」になってしまったり・・・難しいです。

そもそもこのExcelファイルはPDFをExcelに変換したものだったのですが、他のソフトを使って再度変換してみたら、全く結合なしか、列の結合だけになったので扱いやすくなり、セルの結合を判定をしなくても済むようになりました。
もっと早く試してみればよかったです。すみません。

セルの結合の判定方法を教えていただきありがとうございました。
とても勉強になりました。