VBAのコードを教えて下さい。

質問

VBA初心者です。
色々検索してもどれを使えば良いか分かりません。宜しくお願い致します。

シート１に他シート（約100枚）選択範囲（”A3：D4”，"E3：K12")のデータ（A3：D4には顧客名、E3：K12には契約内容。契約内容は9行ありますが空白もあり、月によって入力されている値が変化します。3行になったり7行になったりと。9行は固定で範囲内で行数が変化します。

シート１に全ての顧客名と契約内容を一覧で表示させる方法を教えて頂きたいです。
どうか宜しくお願い致します。

尚、シート1には他のコードも記入されております。そのコードの下に直接書いても大丈夫なのでしょうか？

回答No.5

tom04 · ベストアンサー

No.3・4です。

＞(1)Ａ－Ｄ列の2行目と3行目を結合し1つのセルにして会社名を入れています。
＞(2)Ｅ－Ｋ列のの2行目から11行目に契約内容を入れています。

とありますが、なかなか実際の表の配置が見えてきません。

結局、各シートのE列に2行以上のデータがあればE～K列データのみを表示する！という解釈で
コードをいじってみました。

Sub 全Sheet表示()
Dim k As Long, endRow As Long
Application.ScreenUpdating = False
endRow = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
If endRow > 2 Then
Worksheets(1).Rows(2 & ":" & endRow).Clear
End If
For k = 2 To Worksheets.Count
With Worksheets(k)
endRow = .Cells(Rows.Count, "E").End(xlUp).Row '←ココを変更（E列の最終行）
If endRow > 1 Then '←ココを変更（最終行が2行以上あれば）
Range(.Cells(2, "E"), .Cells(endRow, "K")).Copy Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
'↑　E列～K列を表示したいSheetのA列にコピー
End If
End With
Next k
Application.ScreenUpdating = True
End Sub

こんどはどうでしょうか？m(_ _)m

お礼

tom04様

先日は大変お世話になりました。
ありがとうございます。tom04様の助けがなかったら今でも頭抱え込んでいたと思います。
本当にありがとうございました。

補足

お世話になります。
何度も何度もありがとうございます。
夕方から頂いたコードを訳して自分なりに改造しようかと思ったのですが調べるだけで今に至っています。

今頂いたコードでしてみましたが、いらない部分もコピーされてました。
分かりにくい質問で本当に申し訳ないです。お時間を割いて頂いて感謝しております。
シートを添付で見て頂きたいですが不可能だと思いますので、これ以上お時間を割いて頂くのは恐縮です。
tom04様ありがとうございます。

回答No.4

tom04

No.3です。
補足の
＞コピペしたらほぼシート全体がコピーされてしまいました。
に関して・・・
前回のコードは行全体をコピー＆ペーストしていますので、当然ご指摘のようになります。

前回のコードで行数はお望み通りであり、A～K列までのコピー＆ペーストをご希望だとすると
↓に変更してみてください。

Sub 全Sheet表示()
Dim k As Long, endRow As Long
Application.ScreenUpdating = False
endRow = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
If endRow > 2 Then
Worksheets(1).Rows(2 & ":" & endRow).Clear
End If
For k = 2 To Worksheets.Count
With Worksheets(k)
endRow = .Cells(Rows.Count, 1).End(xlUp).Row
If endRow > 4 Then
Range(.Cells(3, "A"), .Cells(endRow, "K")).Copy Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
End With
Next k
Application.ScreenUpdating = True
End Sub

ご希望に近い形になりますかね？m（_ _）m

補足

お世話になります。
いつもご丁寧にして頂きありがとうございます。感謝の気持ちでいっぱいです。

先程のコードを試したのですが、やはりほぼコピーされてしまいました。

質問の内容が正しくないのだと思います。
(1)Ａ－Ｄ列の2行目と3行目を結合し1つのセルにして会社名を入れています。

(2)Ｅ－Ｋ列のの2行目から11行目に契約内容を入れています。

Ａ－Ｄ列の2行目から11行目までも他情報が入っています。これもコピーされてしまいます。

上記(1)(2)だけを記載したいのですが、シートの作りを直さないと無理でしょうか。
ご指摘頂けたらシートは作り直します。
お忙しい中度々申し訳ございませんがご指導お願いします。

回答No.3

tom04

こんばんは！
No.1さんの補足を読ませてもらうと

（1）各SheetともA3：D4セルが結合されていて、会社名が入っている
（2）同行のE～K列までが2行ずつ結合されていて各項目が入っている
という解釈での一例です。

＞尚、シート1には他のコードも記入されております。そのコードの下に直接書いても大丈夫なのでしょうか？
に関してですが、別件で回答しているマクロはSheetChangeエベントですので
標準モジュールにコードを記載した方が良いと思います。

Alt+F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt+F8キー　→　マクロ　→　マクロ実行です）

Sub 全Sheet表示()
Dim k As Long, endRow As Long
Application.ScreenUpdating = False
endRow = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
If endRow > 2 Then
Worksheets(1).Rows(2 & ":" & endRow).Clear
End If
For k = 2 To Worksheets.Count
endRow = Worksheets(k).Cells(Rows.Count, 1).End(xlUp).Row
If endRow > 4 Then
Worksheets(k).Rows(3 & ":" & endRow).Copy Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next k
Application.ScreenUpdating = True
End Sub

※　全Sheetのデータを表示させたいSheetはSheet見出しの一番左側に配置してあるという前提です。

このコードを実行すると別件で回答しているマクロが走ってしまいますので、
この質問とは直接関係ありませんが、前回のコードの3行目（変数宣言の次の行）に
＞If Target.Address = "$A$1" Then
と最後から2行目（End Sub　の前の行）に
＞End If
を追加しておいてください。

これ今回のマクロを実行しても前回のマクロは実行されません。

※　はっきりした各Sheetのレイアウトが判らないので、
お望み通りの動きになるかどうかは判りません。m(_ _)m

補足

何度もお世話になり申し訳ありません。
コピペしたらほぼシート全体がコピーされてしまいました。
セルを結合しているので他の場所の値もコピーされてしまうのでしょうか？

度々申し訳ありません。

回答No.2

kamikami30

説明十分ではありませんが、
その説明を聞いただけで、あなたが同じブックやシートを作成できるかどうかを基準に考えて説明してください。

A3：D4 は8つのセルではありませんか？

まぁどちらでもいいですが、一つ一つしっかりやらないと、
スクリプトなんて書いたらぐちゃぐちゃになりますよ。

とりあえず、100枚くらいのシートが１つのブックにあって、

そのシートにはそれぞれ
顧客名と契約内容が記述されている。

顧客名に関しては
A3:D4を結合したセルに1つ

契約内容に関しては
E3:K12の範囲に各行を1つに結合したセルに
上記範囲では10行だが、最大9行ある。
空白の場合があるというのは、
契約内容が未入力なのか、空白文字が入っているのか、
空いている行が途中にあるのかわからないが。
何しろ空白の場合もある。

と言う感じで伝わってますが
なんとなくの理解で、処理のフローだけ

全てのシート名を取得する
取得したシート名は配列にでも入れとく。

シート1(sheet1ではない。)を追加する。

シート1に入力する行を適当な変数に保持しておく。

取得したシート名のシートで順に

顧客名を取得
契約内容を取得(範囲の上の行から順に取得しながら、文字列を後部結合、空のセルがあったら終了)

取得した内容をシート1に入力
適当な変数を+1する

おしまい。

お礼

説明不十分をご理解して頂いてありがとうございます。
やりたいことはその通りです。
おっしゃる通り、ぐちゃぐちゃのままでしようとするからいけないんですよね。

ヒントを頼りにコードを書いてみようと思います。

ありがとうございます。

回答No.1

kamikami30

困ったさんですね。

まず、質問のシートがどんなものかわかりません。

私の普通だと
excelのシートって
項目名か一番上の行とか一番左の列にあって
その次の行とか列に、具体的な項目の内容のデータが入っているもの。

複数行複数列の範囲に同じ項目な時点でまず本当に？と思う。

顧客名と書いただけで、
顧客の姓と名を各列に入れるとか、エスパーじゃないからわからないよ？

状況をしっかり伝えられるように説明してください。
それができない人は、絶対にスクリプトなんて書けないので、
その気がないなら諦めてください。

補足

分かりにくい説明ですいません。

顧客名とは会社の名前です。
会社名は6個のセルを結合して1つA3：D4にし、横に契約内容として商品名と金額と期間が入っています。E3：K12の所です。
１会社に付1シートです。

この説明でお分かりになりますか？
宜しくお願い致します。