VBA/シート名の指定時に変数を使いたい

このQ&Aのポイント
  • エクセルVBAでシート名を指定する際に、変数を使用する方法について質問です。
  • 特定のシートにコピーした内容を貼り付ける際、複数のシートが存在する場合にシート名を変数として指定する方法について教えてください。
  • フォーマルなやり方でシート名を指定する方法では、エラーが発生してしまいます。どのようにすれば正しくシート名を指定できるでしょうか。
回答を見る
  • ベストアンサー

VBA/シート名の指定時に変数を使いたい

タイトルがわかりにくく申し訳ありません。エクセルVBAについての質問です。 ================================= Dim myRng, fnd as Range Set myRng = Sheets("Sheet1").Range("A1:A10") //A1~10セルには野菜名が入っているとします。 For Each fnd In myRng.Areas    ※(省略)Sheet2からfndの値を検索し、見つけたらその行をコピーする記述をしています。    Sheets("野菜_"& fnd.value).Range("A1").Pastespecial.........//★(問題の行です) Next ================================= (※部分は問題なく動作しているため省略させていただきました。) やりたいことはSheet2でコピーした内容を別シートへ貼り付ける動作です。 別シート貼り付けの際、貼り付け先シートが複数存在しますので、シート名を指定したうえでペーストする記述をしたいですのですが、うまくいきません。 例えば 変数fndの値が"トマト"だとします。 貼付先シート名には”野菜_トマト”、”野菜_きゅうり”、”野菜_なす” など複数ありますので、”野菜_”以下にfndの値を加えて貼付先シートを選択したいのです。 しかしながら上の記述ですと、「型が一致しません」「インデックスが有効範囲にありません」などのエラーが発生してしまいます。fnd.valueの部分がよろしくないのだと思うのですが、.valueを外したり、.textに置き換えてみたり、キャストなど試してみたがいずれも失敗に終わりました。 初歩的な質問でお恥ずかしい限りですが、★部分をどのようにするとシート選択がうまくできるかを教えていただけないでしょうか。 拙い説明で申し訳ありません。どうぞよろしくお願いいたします。

質問者が選んだベストアンサー

  • ベストアンサー
回答No.1

For Eachの指定で、 ×:For Each fnd In myRng.Areas ○:For Each fnd In myRng で良いのでは? 実際、エリアは複数領域でなくて1つですし。 -- For Each ~ Nextの中身を、 For Each ~  MsgBox("!") Next とかってしてみると、ループの回数が期待される10回でないって確認できたりするかも。

ljubFelix
質問者

お礼

.Areasは全く盲点でした。これを外しただけで解決できました。驚きの一言です。一人では見当違いなことばかり試していたので本当に助かりました。皆様ベストアンサーにさせていただきたいのですが、初心者目線で一番簡潔でわかりやすかったneKo_quatre様を選ばせていただきます。ありがとうございました!!

その他の回答 (2)

  • dogs_cats
  • ベストアンサー率38% (278/717)
回答No.3

その方法でも問題なく実行出来ますが。 fnd.Valueにトマトが格納されているか、デバックしていますか? http://www.excel-excel.com/vbachair/step1-7.html 仮にsheet1のA1の値をsheet2A列で検索しその行の10列分のデータを指定シートにコピーするコード化してみましたのでご参考まで。 Psr_rngのように変数格納しても構わないかと思います。お好きに方を選択下さい。 値だけの転記であれば書きのようにすれば値だけ転記出来ます。 左右のセル数が同数になるようにセル範囲を指定する必要があります。 Pst_rng .value=CP_rng.value 書式も必要なコピーは.Copy Destinationの方が処理が高速化出来ますのでお勧めです。 CP_rng.Copy Destination:=Pst_rng Sub test() Dim fnd As Range Dim Fcell As Range Dim Myrng As Range Dim CP_Rng, Pst_rang As Range Set fnd = sheets(("sheet1").Range("A1") With Sheets("sheet2") Set Myrng = Cells.Find(What:=fnd.Value, After:=Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole) If Not Myrng Is Nothing Then Set CP_Rng = .Range(Cells(Myrng.Row, 1), Cells(Myrng.Row, 10)) 'Set Pst_rng = Sheets("野菜" & fnd.Value).Range("A1:J1") CP_Rng.Copy Sheets("野菜" & fnd.Value).Range("A1").PasteSpecial End If End With End Sub

ljubFelix
質問者

お礼

このような方法もあるのですね。とても勉強になります。今後の参考にもさせていただきます。ご丁寧にコードを教えていただきありがとうございます。感謝申し上げます。

  • eden3616
  • ベストアンサー率65% (267/405)
回答No.2

「Areas」は複数のセル範囲から該当のセル範囲を指定する場合に使用します。 例えば、A、B、Cの各1~5行目から、2番目のセル範囲を取得する場合、 以下のようにすればイミディエイトに「$B$1:$B$5」が表示されます。 Sub sample() Debug.Print Range("A1:A5,B1:B5,C1:C5").Areas(2).Address End Sub 該当のコードを修正する場合、以下のようになります。 For Each fnd In myRng.Areas    ↓ For Each fnd In myRng.Areas(1)   又は For Each fnd In myRng 前者は、全てのセル範囲「A1:A10」の内、1番目のコレクションであるセル範囲「A1:A10」をセル範囲とする。 (対象のセル範囲が1つしかないので意味がない) 後者は、セル範囲「A1:A10」をセル範囲として指定する。 (対象のセル範囲が1つしかないのであればこれで良い)

ljubFelix
質問者

お礼

大変勉強になりました。こちらの方法で無事解決できました。早々にご回答くださり感謝申し上げます。

関連するQ&A

  • エクセルVBAで(続)

    前日も質問(http://okweb.jp/kotaeru.php3?q=1480399)を出していたものですが、続きがあります。下記は今現在のコードです。 Sub 得意先追加()  Sheets("一覧").Unprotect Dim myRng As Range, a Sheets("新規").Copy before:=Sheets(4) With ActiveSheet .Unprotect 得意先シート登録.Show .Name = .Range("A4").Value & .Range("A3").Value .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True   Set myRng = Sheets("一覧").Range("A65536").End(xlUp).Offset(1) myRng.Value = .Range("A4").Value & .Range("A3").Value Sheets("一覧").Hyperlinks.Add _ Anchor:=myRng, _ Address:="", _ SubAddress:=myRng.Value & "!A1", _ TextToDisplay:=myRng.Value End With Sheets("一覧").Select Range("A4").Activate Selection.End(xlDown).Select ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End Sub 実は一覧シートのA列はコード&得意先名ですが、B列には今期の売上合計(各得意のシートのP10をリンク貼付),D列には前期の売上合計(各得意先のP9よりリンク貼付)があります。 それで,得意先追加を実行しているときに一覧シートのB列・D列にシートの各セルをリンク貼付するにはということなんですが、教えていただけますでしょうか。 宜しくお願いします。

  • VBAでシート名をセルから取得したいのですが

    データシートが数枚あり、そこから、シートごとに必要なデータのみ抽出して、印刷用シート(1枚)にまとめて書きこみたいと思っています。 書きこみは以下のような感じにしています。 Sheets("印刷用シート").Activate Range("A1").Value = Sheets("データ1").Range("A1").Value ここで、データ1というシート名を、色々に変えたいのです。 印刷用シートのセルに「データ1」なり「データ2」なり入力したら、その部分が変わるように変数にしたいのですが、どのようにすればいいでしょうか? VBAを勉強中(初心者)です。よろしくお願いします。

  • VBA中の”シート名”を”アクティブシート”に変更

    いつもお世話になっております。 非常に初歩的な質問なのですが、下記の2つのVBA中のシート名をアクティブシートに変更したいのですが、 sheetName = ActiveSheet.Name で試行錯誤するもうまくいきません。 実際のコードは下記の通りです。 これらのシート名”申請書”をアクティブシートに変更したいのです。 このコードは過去にここで教えて頂いたコードで出来ればこれを修正したいので宜しくお願いします。 1.Sub 申請書登録() Dim NewBookName As String With ThisWorkbook.Sheets("申請書") Windows("1.新規・変更登録申請書(原紙)・リスト②T用.xlsm").Activate For i = 5 To Sheets("規格登録・変更リスト").Range("A1048576").End(xlUp).Row + 1 If Sheets("規格登録・変更リスト").Range("B" & i).Value = "" Then With Sheets("規格登録・変更リスト") .Range("A" & i).Value = Sheets("申請書").Range("E3").Value .Range("B" & i).Value = Sheets("申請書").Range("O3").Value .Range("C" & i).Value = Sheets("申請書").Range("E4").Value ・・・・・・・・・・・・・・・・・・・ 2.Sub 申請書保存() Dim NewBookName As String With ThisWorkbook.Sheets("申請書") NewBookName = .Range("F22").Value & " " & .Range("E4").Value & " " & .Range("A2").Value & " " & .Range("A1").Value Worksheets("申請書").ExportAsFixedFormat Type:=xlTypePDF, Filename:="\***\XXXX\1.申請書\申請書" & "\" & NewBookName End With End Sub

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

    初心者なのですが上司に頼まれてしまい、うまく作れなくて困っています。 いろいろ調べて下のところまで作れましたが、他にどうしたら良いかわからなくなりました。 やりたい事 ・「集計シート」のセル(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   '←この2行がまずおかしい? コピーセル範囲 = "G1:J5" 貼付先シート名 = "集計シート" 番号 = "D6" 貼付先左上端セル = "D7" Range(コピーセル範囲).Copy Worksheets(貼付先シート名).Range(貼付先左上端セル).Paste Application.CutCopyMode = False Sheets("集計シート").Select 行 = 行 + 1 Loop End sub

  • Excel VBAで…。

    データーシート(1)のデータをレイアウトシート(2)に転記するのに 例えば sheets(1).range("A1").value=sheets(2).range("C5").value sheets(1).range("B1").value=sheets(2).range("C6").value sheets(1).range("C1").value=sheets(2).range("C7").value と言うように配置しているのですが もし、シート(1)セルB1の値が空白ならば シート(1)セルC1の値はシート(2)のセルC6に配置・・・ と言うように データがない場合は、転記後の配置は詰めて配置したいのです。 どうすればよろしいでしょうか?

  • 指定セルへ転記するマクロで値が無い場合固定値転記

    シート2の1行目の指定したセルの値をシート1の指定セルに 転記を行いシート1が印刷。 印刷後はシート2の2行目の指定したセルの値をシート1の指定したセルに 転記してシート1が印刷。 シート2にデータが無くなったら停止という以下のマクロにて シート2のO列はシート1のセルA19に順次転記なのですが O列は運用上空白が有る場合が判明した為 値がある場合はその値を転記、値が無い場合は半角で ZZZ と 転記をしたいのですがどこを変更していいのか分かりません。 よろしくお願いします。 Sub データ転記() Dim myRng(1 To 23) Dim cpRng Dim i As Integer Dim n As String, myStr As String With Sheets("Sheet2") Set myRng(1) = .Range("B2") Set myRng(2) = .Range("C2") Set myRng(3) = .Range("D2") Set myRng(4) = .Range("D2") Set myRng(5) = .Range("D2") Set myRng(6) = .Range("E2") Set myRng(7) = .Range("E2") Set myRng(8) = .Range("F2") Set myRng(9) = .Range("F2") Set myRng(10) = .Range("H2") Set myRng(11) = .Range("J2") Set myRng(12) = .Range("K2") Set myRng(13) = .Range("K2") Set myRng(14) = .Range("L2") Set myRng(15) = .Range("M2") Set myRng(16) = .Range("N2") Set myRng(17) = .Range("O2") Set myRng(18) = .Range("P2") Set myRng(19) = .Range("Q2") Set myRng(20) = .Range("R2") Set myRng(21) = .Range("S2") Set myRng(22) = .Range("U2") Set myRng(23) = .Range("G2") End With cpRng = Split("B10,O4,G3,F10,F13,G10,G13,H10,H13,O3,L10,M10,M13,O5,E19,F19,A19,O6,D21,B6,I19,J19,G5", ",") '転記先配列化 With Sheets("Sheet1") .Range("B10,G3,F10,F13,G10,G13,L10,E19,F19,J19,O7,O8,C19,D10,D13,A19,O4,O5").NumberFormatLocal = "@" Do While myRng(1) <> "" For i = 1 To 23 .Range(cpRng(i - 1)).Value = myRng(i).Value Next .Range("C3,C13").Value = Left(.Range("O3").Value, 10) .Range("C10").Value = Mid(.Range("O3"), 11, 6) .Range("O7").Value = Format(Range("O6").Value, "0000000") .Range("O8").Value = Format(Range("J19").Value, "0000000") Call 加工01 Call 加工02 '印刷 .PrintOut For i = 1 To 23 Set myRng(i) = myRng(i).Offset(1) Next i Loop .Range("B10,O4,G3,F10,F13,G10,G13,H10,H13,O3,L10,M10,M13,O5,E19,F19,A19,O6,D21,B6,I19,J19,C3,C10,C13,C19,D10,D13,O8,O7,G5").ClearContents End With For i = 1 To 23 Set myRng(i) = Nothing Next MsgBox "印刷終了" Sheets("Sheet2").Select Cells.Select Selection.Delete Shift:=xlUp Sheets("Sheet1").Select Range("C3").Select End Sub

  • エクセル VBA シートの選択 

    windows XP でエクセル2000を使っています。 Sub aaa() Sheets("Sheet1").Select Dim a As String a = Cells(2, 4) Sheets(a).Select Range("A1").Select End Sub というマクロだと セルに入っている値のシート名を探してくれます。 ですが Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Intersect(Target, Range("B11:b683")) Is Nothing Then Exit Sub Worksheets("Sheet1").Range("C2").Value = Target.Value Dim b As String b = Range("C2).value (←ここをcellsにしてもダメ) Sheets(b).Select Range("A1").Select End Sub これだとsheets(b)を選びません。Sheets(b).Selectのところが黄色くなります。 何処が間違えているのでしょうか。 全くの素人ですが、仕事で必要に迫られています。 わかりやすく回答・解説くれると助かります。

  • VBA空白を除いてコピーが出来ません。ご指導お願いします。

    値のコピー&ペースト(空白を除いてコピー)したいと思っております。 シート1 の A35、D35、I35 をコピー。 シート2 の A2 に貼り付け。 これは、大丈夫です。 シート1 の M2 : O23 をコピー。 シート2 の E2 に貼り付け。 今回の場合ですと、M2 : O13 までに値が入ってます。 ですので、M14 : O23 までが、空白になって記入となってしまいます。 *毎回、値が入る量が違います。 一回のコピーですと、これでもいいのですが、 値を変更して、コピーを続けてしますので、M14 : O23 までが、空白になってM24からのコピーになってしまいます。 空白を除いて、貼り付けしたいのですが、 どうすればいいのかわかりません。 お分かりになる方、ご指導よろしくお願いします。 VBAは以下になっております。 Sub Macro1() ' Application.ScreenUpdating = False Sheets("Sheet1").Range("A35,D35,I35").Copy If Sheets("Sheet2").Range("A2").Value = "" Then Sheets("Sheet2").Range("A2").PasteSpecial Paste:=xlPasteValues Else Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If Sheets("Sheet1").Range("M2:O23").Copy If Sheets("Sheet2").Range("E2").Value = "" Then Sheets("Sheet2").Range("E2").PasteSpecial Paste:=xlPasteValues Else Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If Application.CutCopyMode = False Application.ScreenUpdating = True End Sub よろしくお願いします。

  • VBA 重複する番号があるときは値を貼り付けない

    すみません。 理解しているのが少しなので、ちょっとシンプルなVBAを書いています。 1つのブックに 登録シート =Sheets("登録")           顧客情報シート=Sheets("顧客情報")          販売情報シート=Sheets("販売情報")          売り上げシート=Sheets("売り上げ") 登録シートのボタンを押すと、登録シートに入力した情報が、 各シートに分かれて値が入るようにしています。 下記がコードです。 Private Sub CommandButton1_Click() Dim row As Integer ★★★ row = WorksheetFunction.CountA(Sheets("顧客情報").Columns(2)) + 1 Sheets("顧客情報").Cells(row, 2).Value = Range("A2").Value Sheets("顧客情報").Cells(row, 3).Value = Range("A5").Value Sheets("顧客情報").Cells(row, 4).Value = Range("B8").Value ★★★ row = WorksheetFunction.CountA(Sheets("販売情報").Columns(2)) + 1 Sheets("販売情報").Cells(row, 2).Value = Range("C26").Value Sheets("販売情報").Cells(row, 3).Value = Range("J1").Value row = WorksheetFunction.CountA(Sheets("売り上げ").Columns(2)) + 1 Sheets("売り上げ").Cells(row, 2).Value = Range("H1").Value Sheets("売り上げ").Cells(row, 3).Value = Range("K6").Value End Sub もっと簡単な書き方あるよ。。。と言われるでしょうが、 私が理解して修正等ができるのが、上記でした。。 やりたいことは、2点です。 (1)重複は貼り付けをしない。  登録シートのセル A2に入った数字が、顧客情報シートのB列のどこかに、  既に入力がされていた場合は、★★★で囲まれた部分の値を貼り付けず、  その先の販売情報のシートに貼り付ける作業へと進めたい。  IF などを使えばできますでしょうか?   (2)各シートに入力したものを貼り付けた際、A2より下から順番に各シートのCells(row, 1)の位置に、連番をつけたい。 何卒宜しくお願い申し上げます。

  • excel vba DATAの日集計

    excel vba DATAの日集計 いつもお世話になっています。 "DATA"シートのセル"D2"の日付を変えると表の数値が変わるようにしています。 その日毎のデータを"集計"シートの日別の表に飛ぶようにしているのですが、 1日分の転記するセル数が多く、Select Caseで31日分のコードを書くと、あまりにも プロシージャーが大きくなります。(Case1からCase31・・・結果分割してますが) FOR NEXT なのかな~、もっと効率のいい書き方がありましたらよろしくお願いします。 例:"集計"シート1日分は、9行となります。それぞれ"DATA"シートからの転記です。"DATA"シートのF5+F10,G5+G10~AC5+AC10までそれぞれの値を"集計"シートのG5からAD5まで、F6+F12,G6+G12~AC6+AC12までそれぞれの値を"集計"シートのG13からAD13までといった具合です (日の9行はそれぞれ決まったある行とある行の加算です、これが31日分の行があります) Sub macro() Dim myrng As Range Dim c As Range Set myrng = Sheets("DATA").Range("D2") For Each c In myrng Select Case c.Value Case 1 '1行目 Sheets("集計").Range("G5").Value = Sheets("DATA").Range("F5") + Sheets("DATA").Range("F10") | | Sheets("集計").Range("AD5").Value = Sheets("DATA").Range("AC5") + Sheets("DATA").Range("AC10") | | '9行目Sheets("集計").Range("G13").Value = Sheets("DATA").Range("F6") + Sheets("DATA").Range("F12") | | Sheets("集計").Range("AD13").Value = Sheets("DATA").Range("AC6") + Sheets("DATA").Range("AC12")

専門家に質問してみよう