同じシート名を一枚にまとめる

質問

エクセルのマクロでファイル内の同じシート名を一枚にまとめたい。

シート名が"売上"、"売上（2）"、"売上（3）"・・・
のようになっていて、売上シートの枚数は変動します。
他にも、、"部署"、"部署（2）"、"部署（3）"・・・・
のようにシート枚数が変動します。
売上、部署シートの1行目はタイトル行になっています。
そして、ＢＯＯＫ内には、他にもシートがいくつかあります。

ＢＯＯＫ内の
"売上"シート名を一枚にまとめ、
"部署"シート名を一枚にまとめる方法をどうかご教授願います。

複数のＢＯＯＫから一つのファイルにまとめる事が出来たのですが、
どうやっても、同じシート名同士だけをまとめるマクロが出来ず、
とても困っています。
どうか、助けて頂けないでしょうか？
何卒お願い致します。

ちなみに、
下記は途中で断念した案の一つです。
統合表シートを売上シートが隣に並ばないといけないのと、
売上、売上（2）も隣に並ばないと動かないのと
部署（2）、部署（3）・・・もまとめてしまうから、
駄目でした。
とりあえず、売上だけはまとめようとしました。
下記のコードには、こだわりませんので、助けてください。
お願いします。

Sub まとめ()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim j As String
Dim d As String

Dim i As Integer
Set sh1 = Worksheets("統合表")
j = 2 '統合表のデータ書きこみ開始行
For Each sh2 In ActiveWorkbook.Worksheets
If sh2.Name = "発注" Or _
sh2.Name = "部署" Or _
sh2.Name = "使い方" Or _
sh2.Name = "残すシート" Then Exit For '統合表は統合対象外
d = sh2.Range("A65536").End(xlUp).Row '各シートの最終行を知る
' MsgBox d
For i = 2 To d
sh1.Cells(j, "A") = sh2.Cells(i, "A")
sh1.Cells(j, "B") = sh2.Cells(i, "B")
j = j + 1
Next i
Next
End Sub

回答No.2

Siegrune · ベストアンサー

>下記のコード
## もうひと息な気がするんですけどね。

>For Each sh2 In ActiveWorkbook.Worksheets
これが、１シートずつ処理をしようとしているということですよね？
>If sh2.Name = "発注" Or _
>sh2.Name = "部署" Or _
>sh2.Name = "使い方" Or _
>sh2.Name = "残すシート" Then Exit For '統合表は統合対象外
ここは対象外のシートなら１シートずつの処理を終了する（Exit For）となっていますけど本当？
本当は対象外のシートなら処理をしたくなくて次のシートへ進みたいということですよね？

シート名が"売上"、"売上（2）"、"売上（3）"
のシートだけを処理したいときは、
instr(sh2.Name,"売上")>0 という条件をつかうと便利です。

msgbox(instr("ABC","AB"))やmsgbox(instr("XABC","AB"))、msgbox(instr("ABC","AC"))
をイミディエイトでなりプログラムでなり動かしてみてください。
前者は1や2、後者は0が返ってきます。
つまり、instr(sh2.Name,"売上")>0というのは、シート名に「売上」の文字があるときという
条件になります。(詳しくはVBAのINSTR関数を調べてください。)

ということで、
For Each sh2 In ActiveWorkbook.Worksheets
If sh2.Name = "発注" Or _
sh2.Name = "部署" Or _
sh2.Name = "使い方" Or _
sh2.Name = "残すシート" Then Exit For '統合表は統合対象外
を
For Each sh2 In ActiveWorkbook.Worksheets
If instr(sh2.Name,"売上")>0 then
とし、
Next i
Next
を
Next i
END IF
Next
とすると、売上シートに関してはお望みのことができるでしょう。

>"部署"シート名を一枚にまとめる
も同様の処理を下に書いてあげるとできるでしょう。
## 本当は、売上と部署の両方を一度に処理するほうが、効率いいのですが、
## まずは、１個ずつ別々にできるようにならないと混乱するだけかと思います。

お礼

ありがとうございます！！！
きちんと動きました。
ずっと、孤独にマクロをやってきて、
誰にも助けてもらえなかったので、
こんなにも親切に教えてくださり、とてもうれしいです。
感謝しきれません。
これから、もっとマクロを勉強します！！

回答No.1

imogasi

>同じシート名を一枚にまとめたい。
書き方が雑。後を読めば判るが。しっかり表現せよ。
ーー
（１）同じファイル名がどれだけあるかとらえるコードは出来たのか。
（２）（１）のそれぞれについてシート名で（）を除いて比較して同じかどうか判別する。
（３）同じならどうするのか。集約シートを新たに作るのか。（）無しのシートのデータの次に加えていくのか。質問に書いてあるか。
（４）集約シートの最終行を割りだし、その次の行以下に貼り付け（初心者が聞きそうなところはここか）
ーーー
（１）は手作業で今回は解決するとして
元シート名
Ｓｈｅｅｔ1
Ｓｈｅｅｔ2
Ｓｈｅｅｔ１(2)
Sheet1(3)
Sheet3
白紙のシートＳｈｅｅｔ１集約、Ｓｈｅｅｔ2集約、Ｓｈｅｅｔ３集約を作っておく。
データ　すべて第１行目（見出し行）からで、２列のデータと仮定。
Ｓｈｅｅｔ１
ＸＸ　　　ＹＹ　＜－列見出し
a 1
b 2
c 3
d 4
Ｓｈｅｅｔ2
ＵＵ　　　ＶＶ
aa 100
bb 101
cc 102
Ｓｈｅｅｔ１(2)
ＸＸ　　　ＹＹ
x 11
y 12
z 13
Ｓｈｅｅｔ１(3)
ＸＸ　　　ＹＹ
u 21
v 22
w 23
s 24
t 25
Ｓｈｅｅｔ3
ＺＺ　　　　　ＵＵ
aaa 201
bbb 202
ccc 203
ーーーー
コード　標準モジュールに
Sub test01()
Dim ch
For Each ws In Worksheets
x = ws.Name
If InStr(x, "集約") = 0 Then
p = InStr(x, "(")
If p <> 0 Then
y = Left(x, p - 1)
Worksheets(x).Activate
Range("A2").CurrentRegion.Select
With Selection

.Range(Cells(2, "A"), Cells(.Rows.Count, "B")).Copy _
Worksheets(y & "集約").Range("A65536").End(xlUp).Offset(1, 0)
End With
Else
y = x
Worksheets(x).Range("A2").CurrentRegion.Copy Worksheets(x & "集約").Range("A1")
End If
MsgBox y
End If
Next
End Sub
ーー
結果
Ｓｈｅｅｔ1集約
ＸＸ　　　ＹＹ
a 1
b 2
c 3
d 4
x 11
y 12
z 13
u 21
v 22
w 23
s 24
t 25
他の集約シートは掲載略。
まず上記の例でやってみて、自分の場合に修正する個所を見つけてみてください。

お礼

私のつたない説明に、親切回答くださり、ありがとうございます。
コードのこの修正を、ずっとやっていましたが、
どうしても、私では出来ませんでした。
.Range(Cells(2, "A"), Cells(.Rows.Count, "B")).Copy _
Worksheets(y & "集約").Range("A65536").End(xlUp).Offset(1, 0)
ここで止まってしまうので、ｓｅｌｅｃｔｉｏｎが違うのかなとか、
修正しましたが、解決できませんでした。
やはり、基本がまだ理解できていないようです。
もっと、勉強します。ありとうございます。