EXCEL VBAコミュの複数シートの結合　（特定の部分のみ）

結合とは具体的にどうしたいのでしょうか？

どのようなデータがどのようにあるのか分かりませんが
重複するものを省きたいということでしょうか？

Sheet1にもSheet2にも、
同じ場所（９行２列目（R9C2）〜３２行１７列目（R32C17））にデータがあります。

このデータを、一枚のSheetにしたいですが、

よろしくお願いします。

これを４０回繰り返したいのですが、可能ですか？
黄色・緑・黄色・緑・・・・って感じで。

「マクロの記録」を使って、手作業でコピペしたものをVBAにすると参考になるものが出来るかもよ。

単純に下に張り付けて、別々のSheetにあったものを
1つのSheetにまとめたいということであれば
抜粋したい範囲を指定してコピー、Worksheets(1)のA列最終行+1行目に
貼り付けをするというようにすればよいのでは？

>5
Sheetが41枚あれば、40回繰り返すのでは？
2 To Worksheets.Count
なんですから・・・

>黄色・緑・黄色・緑・・・・って感じで。
同じものを張り付けるのですか？

fenwickさん
ありがとうございます。試しています。

マリ男さん
お世話になております。

Sheetが41枚あれば、40回繰り返すのでは？
2 To Worksheets.Count
なんですから・・・
＞おおよそで、ファイルによって異なります。

>黄色・緑・黄色・緑・・・・って感じで。
同じものを張り付けるのですか？
＞異なるものです。紛らわしい書き方してごめんなさい。

>9
>おおよそで、ファイルによって異なります。
Sheet数に関係なく40回繰り返すのであれば
For...Nextステートメントの終了値を変更すれば良い話では？

ただ、41枚Sheetが存在しない場合、エラーになると思いますが

もしくは、2枚目のSheet以降すべてに対してコピー貼り付けをさせたい
ということでしたら、そのままで良いと思いますが？

>異なるものです。
2枚目以降のSheetの抜粋したい範囲を1枚目のSheetに張り付ける
ということでよいでしょうか？

>異なるものです。
2枚目以降のSheetの抜粋したい範囲を1枚目のSheetに張り付ける
ということでよいでしょうか？

おっしゃる通りです。

３３行目にもデータがあるのですが対象外にしたいのです。
また、１列目も削除したいのです。

>11
>３３行目にもデータがあるのですが対象外にしたいのです。
>また、１列目も削除したいのです。

>0で仰っている
９行２列目（R9C2）〜３２行１７列目（R32C17）
を範囲としてコピーしたいということでしょうか？
でしたら、コピーする範囲をその範囲に変更すれば出来ませんか？

>異なるものです。
2枚目以降のSheetの抜粋したい範囲を1枚目のSheetに張り付ける
ということでよいでしょうか？

おっしゃる通りです。

３３行目にもデータがあるのですが対象外にしたいのです。
また、１列目も削除したいのです。

はじめまして。

横槍のようで申し訳ありません。
トピックのコメントルールなど、読み落としていてルール違反があれば、ご指導をお願いします。
m(_ _)m

まず、Chieさんの作ったソースコードが貼り付けられていますが、Chieさんがやりたい処理と、実際の動作に、どのような違いがあるのかを教えてもらえませんか？

以下は僕の想像ですが…

・Chieさんのやりたい処理
　Sheet2〜最終シートの、セルB9〜R32(R9C2〜R32C17)をコピーして、Sheet1に貼り付けていく

・実際の動作
　Sheet1に対してコピー＆ペーストが行われない

ではないでしょうか？

だとすれば、各シートの最終行を求めるend(xlup)で指定している列を2にすれば、解決するような気がしますが…


　

戊さん

こちらこそルール違反があったら、ご指摘ください。

やりたいことは、まさにそうなの！

実際の動作は、セルB9〜データーの最後までコピーされちゃうんです。

なので、シート毎に不要部分を削除するマクロを作って、行ってます。

各シートの最終行を求めるend(xlup)で指定している列を2にすれば。。。
＞ありがとうございます。６日、試してみますね。

Chieさん

回答ありがとうございます。

> 実際の動作は、セルB9〜データーの最後までコピーされちゃうんです。

なるほどなるほど。
画像で提示いただいているデータには、A列に値が入っていないように見えたので、
「If lRow >= 2 Then」の条件がFalseになっているのか？　と思いましたが、逆なんですね。

ともあれ、事情はおおよそ理解できたと思います。
問題のポイントは、コピーする領域を

　lRow = .Cells(Rows.Count, 1).End(xlUp).Row
　lCol = .Cells(1, Columns.Count).End(xlToLeft).Column

で求めてしまっている点ではないでしょうか。

これは、もしコピー元のシートのセルA100に値が入っているとlRowは100、
セルZ1に値が入っているとlColは26となってしまうため、コピーする範囲がこの場合、
B9〜Z100になってしまいます。

セルB9から、↑で求めたセル座標までをコピー範囲にしてしまっているので、
全てのデータがコピーされてしまっているのでしょう。

ですので、#12でマリ男さんがアドバイスしてくれている通り、

　> コピーする範囲をその範囲に変更すれば出来ませんか？

という修正を加えれば、Chieさんの望む結果を得られるはずです。

……
説明が長くなりましたが、私の方でサンプルを作成してみました。
こんな感じでいかがでしょうか？

=== SAMPLE ===


Sub matome()

'==============================================================
' 変数を定義
'==============================================================
Dim SheetCnt As Integer

Dim MaxRow As Long
Dim MaxCol As Integer
Dim MaxRow_Sheet1 As Long

Dim ProcDone As Boolean

'==============================================================
' 処理
'==============================================================
Application.ScreenUpdating = False

'----全データシートの有無をチェックします
sh_check

'----列見出しをコピーします
With Worksheets(2)
.Activate
.Range("6:3").Copy
End With

With Worksheets(1)
.Activate
.Range("A1").Select
.Paste
End With

'----Sheet2〜最終シートまでの値をコピーして、Sheet1に連結します
For SheetCnt = 2 To Worksheets.Count

With Worksheets(SheetCnt)

'----コピーするシートの最大行、最大列を取得する
MaxRow = .Cells(Rows.Count, 2).End(xlUp).Row
MaxCol = .Cells(1, Columns.Count).End(xlToLeft).Column

'----シートのデータが2行以上の場合にコピーします
If MaxRow >= 2 Then

'----ペースト対象のシート(Sheet1)の最大行+1(貼り付け位置)を取得
MaxRow_Sheet1 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1

'----コピー対象のシートのセルをコピーして、Sheet1に貼り付け
.Activate

' ここがポイント！　コピー対象のシートの最大列/行を求めずに、固定値でコピー範囲を指定しています。
.Range("B9:R32").Copy Worksheets(1).Cells(MaxRow_Sheet1, 1)

ProcDone = True

End If

End With

Next SheetCnt

Worksheets(1).Activate

Range("A9").Select

Application.ScreenUpdating = True


' 処理が行われたかどうかでメッセージを分岐
If ProcDone = True Then

MsgBox "処理が完了しました。", vbInformation + vbOKOnly

Else

MsgBox "処理対象のデータが見つかりませんでした。" & Chr(10) & Chr(10) & _
_
"シートの内容を確認してください。", vbExclamation + vbOKOnly

End If

End Sub

戊先生

返信遅くなってごめんなんさい。

MsgBox "処理対象のデータが見つかりませんでした。" & Chr(10) & Chr(10) & _
にて、構文・コンパイラエラーになってしまいました。

私には、難しです。
御休みを有効活用して、みなさんのようにVBAができるように努めたいと思います。

今後ともご指導のほど、よろしくお願い致します。

Chie

>18
MsgBox "処理対象のデータが見つかりませんでした。" & Chr(10) & Chr(10) & _
"シートの内容を確認してください。", vbExclamation + vbOKOnly

でいきませんか？

マリ男先生

出来ました！

ありがとうございます。
アンダーバーが入ってたから、駄目だったのかな？

本当、ありがとうございます。
お陰様で、時間短縮できました。

みなさんみたいになりた〜い！
今後とも、ご指導のほどよろしくお願い致します。

Chie

>20
余計なところにアンダーバーがあったのが問題だったのだと思います
>19にもアンダーバーは入っていますから
アンダーバーの働きが分からなければ調べれば出てくると思いますよ

> 18 - 21

戊です。

なるほど！
こちらで作ったときは、

> MsgBox "処理対象のデータが見つかりませんでした。" & Chr(10) & Chr(10) & _
> _
> "シートの内容を確認してください。", vbExclamation + vbOKOnly

2行目のアンダースコアの前に半角スペースが入っていたんですが、
ここに貼り付けると、先頭のスペースは省略されてしまうんでしたね

良い勉強になりました、気をつけます