「セルにある値」名のシートのデータコピー方法

質問

初心者なのですが上司に頼まれてしまい、うまく作れなくて困っています。
いろいろ調べて下のところまで作れましたが、他にどうしたら良いかわからなくなりました。

やりたい事
・「集計シート」のセル（B3からB15）に入力したシート名から
　一部のセルをコピーし、順に「集計シート」に貼り付ける
例：「集計シート」のB3にA　B4にB　B5にC　
　　B6には空欄（これ以上はシートなし）
　「Aシート」の(G1:J5)を「集計シート」のB5を先頭に貼り付け
　「Bシート」の(G1:J5)を「Aシート」貼付分の後に一行入れ貼り付け
　「Cシート」の(G1:J5)を「Bシート」貼付分の後に一行入れ貼り付け
　以上

疑問
「Do until」で空欄になるまで貼付を繰り返せない（混乱中）
「Aシート」の貼り付け後に一行空けて、貼り付けの繰り返し
（これはまったくわからない）

行 = 3
Do Until Range("B" & 行).Value = ""

シート名 = Range("B" & 行).Value　'←ここがエラーになります
Worksheets(シート名).Select　　　'←この２行がまずおかしい？

コピーセル範囲 = "G1:J5"
貼付先シート名 = "集計シート"
番号 = "D6"
貼付先左上端セル = "D7"

Range(コピーセル範囲).Copy
Worksheets(貼付先シート名).Range(貼付先左上端セル).Paste
Application.CutCopyMode = False
Sheets("集計シート").Select

行 = 行 + 1
Loop
End sub

回答No.2

imogasi · ベストアンサー

Aシート」の(G1:J5)やBシート」の(G1:J5)を、のJ5は固定したものなのか、５は最終行なのか。
関連して最下行を捉える
d = Worksheets("集計シート").Range("G65536").End(xlUp).Row
を知らないのだろう。便利だから勉強を売ること。
ーーー
注意
＞B5を先頭に貼り付け
B列にはシート名を入れている。ここの列の下方にデータを入れることは望ましくない。G7（G5にも出来る）にした。質問者で適当に修正をすること。シートを３つに固定してよくてFor i=2 to 5にして
B6からデータを入れることは出来るだろう。
ーーー
Msgbox wo除くと７行で出来ちゃう。
Sub test02()
d = 5 '集約開始G5の5
For i = 3 To 15
If Worksheets("集計シート").Range("B" & i) <> "" Then
sn = Worksheets("集計シート").Range("B" & i)
MsgBox sn
Worksheets(sn).Range("G1:j5").Copy Destination:=Worksheets("集計シート").Range("G" & d + 2)
d = Worksheets("集計シート").Range("G65536").End(xlUp).Row
MsgBox d
End If
Next i
End Sub
テスト
集約シート
B３：B5
Sheet1
Sheet2
Sheet3
ーーー
Sheet1
G1:J4
z 0 w 10
a 1 x 11
b 2 y 12
c 3 z 13
d 4 u 14
Sheet2,Sheet3も同じ範囲に類似データを作る
実行
集約シート
G7:J２３　最初の行を５行からなら,d = 5 '集約開始G5の5のところ
をd = 3 '集約開始G5の5より

z 0 w 10
a 1 x 11
b 2 y 12
c 3 z 13
d 4 u 14

z 11 w 20
a 12 x 21
b 13 y 22
・・・以下略

お礼

詳しい説明ありがとうございました。
上の構文を加工して、基本的な動作はなんとかするようになりました。

ですが「B3からB15に入力したシート名」の中に数値もあるのですが、
入力前にセルの表示形式を「文字列」にしないとエラーになります。
例：何も設定せずB3に50と入力　→　エラー
　　表示形式を文字列に設定してからB3に50と入力　→　動作する

シート名は「50」「61」「A」などがあります。
文字の型の問題だと思うのですが、どうやって設定したらよいのでしょうか・・・

回答No.5

hige_082

＃４です
＃３で追加した１行を削除してくださいと言うのを忘れてました
すみません

解決して、良かったですね
それでは

回答No.4

hige_082

＃１、＃３です
全角半角の問題では無いとの事なので
＞「インデックスが有効範囲にありません」のエラーからデバッグに入ると
集計シートのB3に空白かシート名に使用されていない文字列が入っている事が原因だと思います
Excel2000で動作の確認は行っています

まあ、imogasiさん（imogasiさん横から失礼します）のでうまく行っているようなので
エラーの回避方法のみ

Sub test02()
dim　sn　as　string　'この位置に1行追加
　　：

以上参考まで

お礼

１行を追加する事で、無事エラーを回避する事ができました。
これで、セルの書式設定を「標準」にしているままでも、
数値のシート名の取得ができます。

「インデックスが・・・」のエラーは、Ｂ３は空白でもないし、
セルとシート名の全半角を別の判りやすい文字に揃えてもダメでした。
たぶん、自分がどこが間違っているんでしょうね。

ひとまず、無事目的の物ができあがりました。
回答者さま、imogasiさんありがとうございました。

回答No.3

hige_082

＃１です
＞文字の型の問題だと思うのですが、どうやって設定したらよいのでしょうか・・・
違うと思うけど
全角半角の問題だと思う

試しに
１行追加してみて

　　　：
For 行 = 3 To 5
シート名 = Worksheets(貼付先シート名).Range("B" & 行).Value
シート名 = StrConv(シート名, vbWide)　　'追加
If Worksheets(貼付先シート名).Range("d7").Value = "" Then
　　：

補足

全角半角の問題ですか。

今回追加するのは、hige_082さんの構文に追加でいいんですよね？
（上のアドバイスを見るとそうですよね？）
全角半角の問題が発生したのはimogasiさんの構文で作成した時のエラーです。

上の追加作業を行った結果、やはりエラーが発生します。
（＃１の時に報告したエラーのままです）
今回アドバイスいただいたのは、半角全角の対応方法のみなので、
＃１の時のエラー対応にはなっていないってことでしょうか。

また、全角半角についてチェックしてみましたが、
入力は、imogasiさんへの回答でも書いたとおりのパターン両方とも、
半角になっています。
エクセルの自動機能の為、セルに全角で数値を入力しても「半角で右による」し、セルの表示形式を「文字列」にした後でも半角で入力しています。

回答No.1

hige_082

こんばんわ
もっと整理して考えれば
＞例：「集計シート」のB3にA　B4にB　B5にC　
＞　「Aシート」の(G1:J5)を「集計シート」のB5を先頭に貼り付け
「集計シート」のB5はシート名、それとも貼付の先頭？
もう少し基本を勉強された方が良いですよ
シートの指定の仕方が、よく理解できていないではと思います

条件が良く分からないので
参考程度に

Sub test()
Dim 行 As Integer
Dim コピーセル範囲 As String
Dim 貼付先シート名 As String
Dim シート名 As String
コピーセル範囲 = "G1:J5"
貼付先シート名 = "集計シート"
For 行 = 3 To 5
シート名 = Worksheets(貼付先シート名).Range("B" & 行).Value
If Worksheets(貼付先シート名).Range("d7").Value = "" Then
Worksheets(シート名).Range(コピーセル範囲).Copy Worksheets(貼付先シート名).Range("d7")
Else
Worksheets(シート名).Range(コピーセル範囲).Copy _
Worksheets(貼付先シート名).Range("d65536").End(xlUp).Offset(2)
End If
Next
End Sub

お礼

ありがとうございます。
参考にして（というか、一度ほぼそのまま利用させてもらいました）
ですが、下記の部分でエラーが発生します。

「インデックスが有効範囲にありません」のエラーからデバッグに入ると、
Worksheets(シート名).Range(コピーセル範囲).Copy Worksheets(貼付先シート名).Range("d7")

が選択されています。
これはどこが悪いのやら・・・