• 締切済み

【VBA】 超初心者です 複数のシートに転記したい

Sub べんきょう() Worksheets(Array(1, 3)).Select Range("A1").value = 20 End Sub もしくは Sub べんきょう() Worksheets("sheet1").Select Worksheets("sheet3").Select False Range("A1").value = 20 End Sub でやってもsheet1にしか転記されないんです!! ご指導よろしくお願いします!

みんなの回答

  • onlyrom
  • ベストアンサー率59% (228/384)
回答No.5

No2、onlyromです。 超エキスパートのWendy02さんから目から鱗の回答がありました。 複数シートを選択して、それらの同じセルに処理をしたい場合はSelectionプロパティが適しているようです。 '------------------------------------ Sub 色付けの勉強() Worksheets(Array(1, 3)).Select Rows("3:3").Select Selection.Interior.ColorIndex = 3 End Sub '------------------------------------------ Sub ひとつのセルへ値代入()  Worksheets(Array(1, 3)).Select  Range("A1").Select  Selection.Value = 20 End Sub '---------------------------------- Sub 複数セルへ値代入()  Worksheets(Array(1, 3)).Select  Range("B3:C5").Select  Selection.Value = 55 End Sub 以上。

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.4

こんばんは。 以下のマクロは、シートごとにひとつずつ入れているわけではありません。 これは、ワークシートのひとつの機能を間接的に利用した、特殊なマクロのひとつです。 あまり、「べんきょう」というものにはなりませんし、このようなマクロは、めったに使われない、というか、使わないワザのひとつです。 'シート1,3を入れる場合 Sub べんきょう2()  Worksheets(Array(1, 3)).Select  Range("A1").Select '範囲でも可能です。  Selection.Value = 15 '数式の場合は、.Formula を使います。  Worksheets(1).Select '作業グループ解除 End Sub '全シートを入れる場合 Sub べんきょう3()  Worksheets.Select '全シートに入れる  Range("A1").Select  Selection.Value = 25  Worksheets(1).Select '作業グループ解除 End Sub

noname#79209
noname#79209
回答No.3

直接の回答ではありませんが、 VBAを使わなくても、Sheet1のセルA1のデータをShwwt2のA1と同じにしたいなら、 Sheet2のA1に「=Sheet1!$A$1」とすればよいだけです。 ご質問の例なら、Sheet1のセルA1に20と入力するだけでSheet2のA1ににも20と表示されます。

  • onlyrom
  • ベストアンサー率59% (228/384)
回答No.2

Sub べんきょう() Worksheets(Array(1, 3)).Select Range("A1").value = 20 End Sub これで説明します。 簡単の為に、Sheets(1)とSheet1は同じとする。 上記のように、Range("A1") のみではその前にシート名がないので ActiveSheetのセルA1を指定していることになるのです。 で、ActiveSheetは、1,3のどれかというと Worksheets(Array(1, 3)).Select と、1から先に指定してますから、ActiveSheetは、Sheet1 になるので、 Sheets("Sheet1").Range("A1").Value = 20 と指定したことになり、Sheet1にしか20は入らないのです。 また、同じように、 Worksheets(Array(3,1)).Select と、3から指定すると、Sheet3にのみ20が入ることになります。 要するに、質問者提示のコードは  Sub べんきょう()   Worksheets(Array(1, 3)).Select   ActiveSheet.Range("A1").value = 20 又は、   Sheets(1).Range("A1").Value = 20  End Sub と、同じことだということです。 (結論) 複数のシートを選択して同じセルに同じ値を入れたい場合は、 そのセルをアクティブにして、ActiveCellプロパティを使用しなければいけない。 で、以下のようになります。  Sub べんきょう()   Worksheets(Array(1, 3)).Select   Range("A1").Activate   ActiveCell.value = 20  End Sub 以上。  

ayako99
質問者

お礼

ありがとうございました。 単体のセルだとできたんですが 複数のセルを選択したら出来ませんでした Range("3:3").Activate ActiveCell.Interior.Color = xlNone このような選択をしたい場合はどうすればいいのでしょうか…?

  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.1

Sub べんきょう01() Worksheets(Array(1, 3)).Select Worksheets(1).Activate Range("A1").Select ActiveCell.Value = "30" End Sub Sub べんきょう02() Worksheets("sheet1").Select Worksheets("sheet3").Select False Worksheets("sheet1").Activate Range("A1").Select ActiveCell.Value = "20" End Sub Sub べんきょう03() Worksheets(1).Range("A1").Value = "10" Worksheets(3).Range("A1").Value = "10" End Sub ではいかがでしょう?

関連するQ&A

  • 複数のシートに 転記

    Sub べんきょう()   Worksheets(Array(1, 3)).Select   Range("3:3").Activate   ActiveCell.ClearContents  End Sub シート1,3の3行目のデータを消したい もしくは Sub べんきょう()   Worksheets(Array(1, 3)).Select   Range("3:3").Activate   ActiveCell.Interior.color = xlNone  End Sub シート1,3の3行目の色を消したい うまくいかなくて困ってます…。 どなたかどうかご指導よろしくです。

  • excel ユーザーフォームでシートごとに転記2

    先日ユーザーフォームへの転記について質問させていただきました。 ご回答いただき、ありがとうございました。 今度はオプションボタンで選択したときに、シートごとに転記する方法を 教えていただけますでしょうか。 ユーザフォーム上で、オプションボタンを選択。 OptionButton1・・・シート1へ転記 OptionButton2・・・シート2へ転記 これをOKボタンを押したときに転記するようにしたいと思っています。 Private Sub OK_Click() Dim CLrow As Long Dim KYrow As Long CLrow = Worksheets("Sheet1").Range("A65536").End(xlUp).Row KYrow = Worksheets("Sheet2").Range("A65536").End(xlUp).Row If OptionButton1.Value = True Then Worksheets("Sheet1").Range("A" & CLrow).Value = .TextBox1.Value ElseIf OptionButton2.Value = True Then Worksheets("Sheet2").Range("A" & KYrow).Value = .TextBox1.Value End With End Sub ここまでやってみたのですが「参照が不正または不完全です」 と出てしまいます。 どなたかご教示願います。 よろしくお願いします。

  • エクセルVBA 1つのシートで出来ますか?

    説明が下手で申し訳ございませんが、宜しくお願い致します。 sheet(1)に20個のボタンがあります。 ボタンをクリックすると、別のシートが開きます。 開いたシートにも複数のボタンがあり、そのうちの任意のボタンをクリックすると、そのボタンの値がsheet(1)のそれぞれのボタンに対応したセルに入力される、という動作を実現したいと思っています。 現状、下記のようなコードで目的の動作は実現できてはいるのですが、各ボタンそれぞれにシートを作っているような状況です。(データ自体は全く同じ内容のものが、計20シート) たぶん、もの凄く頭の悪い事をやっているんだろうと思います。 sheet(1)を除いた各シートの入力データ自体は全く同じなので、シート一枚で出来るんじゃないのかなと思い、ネットや本で調べながら色々試してみたのですが、どうも上手く行きません。データが同じでも、sheet(1)のクリックしたボタンによって入力するセルを変えなければならないのが問題です。 sheet(1)のボタンとセルの関連付けや、sheet(1)のどのボタンを押したのかの判別ができればいいのかなと思って調べてみても、初心者にはよく理解できず、もう何週間もチャレンジしているのですがお手上げです。 上級者の方の知恵をお借りできれば幸いです。 Sub sheet2を開く() Worksheets(2).Select End Sub Sub 入力1() Worksheets(1).Range("F8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("F8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("F8") = "データ3" Worksheets(1).Select End Sub Sub sheet3を開く() Worksheets(3).Select End Sub Sub 入力1() Worksheets(1).Range("H8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("H8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("H8") = "データ3" Worksheets(1).Select End Sub Sub sheet4を開く() Worksheets(3).Select End Sub Sub 入力1() Worksheets(1).Range("M8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("M8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("M8") = "データ3" Worksheets(1).Select End Sub    ・    ・    ・    ・    ・

  • マクロでシート2~6のデータをシート1に転記したい

    マクロでシート2~6のデータをシート1に転記したいです。 シート2~6のデータを シート1に順番に転記したくてマクロの記録を利用して作成しました。 シート2~6は列は同じですが行数は異なります。 また行数は作業の都度異なります。 同じ記述が繰り返されているので もう少し記述が短くできるのではと思うのですが どうすればいいでしょうか? Sub データ更新() 'シート1の前回データをクリア Sheets("シート1").Select Range("A2:Q2").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("A2").Select Sheets("シート1").Select Range("A1").Select Sheets("シート2").Select Range("A1").Select 'ヘッダーも合わせて取得 Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート3").Select Range("A2").Select 'データのみ取得 Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート4").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート5").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート6").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select End Sub

  • 印刷後のVBAの実行 (3)

    Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "Sheet1" Then If Range("D6").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D6").Select Exit Sub End If Else If ActiveSheet.Name = "Sheet2" Then If Range("C11").Value = "" Then Cancel = True MsgBox ("受付時間を入力してください") Range("C11").Select Exit Sub End If Else Exit Sub End If End If If Worksheets("Sheet1").Range("D5") = "不要" Then GoTo P1 ActiveSheet.Range("A70:Y70").Copy If Worksheets("Sheet3").Range("A1").Value = "" Then Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues Else Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False P1: ActiveSheet.Range("A1").Select End Sub sheet1のD5に「不要」と入っていたら 24~33行目の作業がキャンセルになりますが sheet2のD5にも「不要」と入っていたら、同じ様にキャンセルできる様に出来ますでしょうか? ご回答お願いします

  • VBA転記について教えて下さい

    200件位のデータがあるとします。顧客情報AB・商品C~AY 氏名 性  青森りんご 長野りんご みかん バナナ 送料 AA  男   1             2      100 BB  女          1            100 CC  男                   3     0 このデータを別シートAにはりんごと送料 別シートBにはそれ以外のデータに分けたいのです。 シートA 氏名 性  青森りんご 長野りんご  送料 AA  男   1           100 BB  女        1    100 CC  男 シートB 氏名 性  みかん バナナ AA  男    2 BB  女 CC  男       3 こんな感じです。 色々参考にして作成しましたがうまくいきませんでしたので 教えて欲しいです。 よろしくお願いします。 エクセルは2002です。 1、項目名の転記でデータは200位ですが変動があるので最終行で作成したら うまくいきませんでした。 2、データ域の転記が動きません。 Sub サンプル() Dim i As Long Dim lastRow As Long Dim lastcolumns As Long Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet Dim myColumns As Long Dim myKey As String Set S1 = Worksheets("データ") Set S2 = Worksheets("りんご") Set S3 = Worksheets("その他") ' Sheet1の最終行を取得 lastRow = S1.Range("A" & Rows.Count).End(xlUp).Row ' Sheet1の最終列を取得 lastcolumns = S1.Cells(1, Columns.Count).End(xlToLeft).Column ' 項目名の転記 S2.Range("A1:B200").Value = _ S1.Range("A1:B200").Value S3.Range("A1:B200").Value = _ S1.Range("A1:B200").Value 'データ域の転記 For i = 2 To lastcolumns myKey = S1.Cells(1 & i).Value If myKey <> "" Then myColumns = Worksheets(myKey).Cells(1, Columns.Count).End(xlUp).Columns + 1 S1.Range(S1.Cells(1, i), S1.Cells(lastRow, i)).Copy _ Worksheets(myKey).Range(Cells(1, myColumns), Cells(lastRow, myColumns)) End If Next i End Sub

  • エクセルVBAの転記について

    エクセル2013VBAで最終行を取得しての転記が上手くいきません。どのようにすれば良いかご教授ください。 簡単なサンプルを下記します。 Sub サンプル入力からのDBへの転記() Dim Sh1 As Worksheet Dim Sh2 As Worksheet Dim myRow As Long Set Sh1 = Worksheets("サンプル入力") Set Sh2 = Worksheets("サンプルDB") With Sh2 myRow = Range("A" & Rows.Count).End(xlUp).Row + 1 .Range("A" & myRow).Value = Sh1.Range("D4").Value .Range("B" & myRow).Value = Sh1.Range("F4").Value End With End Sub 入力内容を変えないテストでは (1)実行するとDBへの転記は問題なく出来ます。 (2)継続してマクロを実行しても問題なく転記が行われ、同じデータが蓄積されていきます。 入力内容を変更して引き続きマクロを実行すると挙動不審に陥ります。 現象としては (1)初めの行に何度も重ねて転記を行う。 (2)空白行を作り、その行に何度も転記を行ってしまう。 (3)空白行を作り、それ以降転記を実行し蓄積を行ってしまう。 入力シートには結合セル、リストを使用していますが、原因究明を行う中でこれが原因とは思えませんでした。 これがクリアできないと先に進めません。ぜひお力を貸してください。 宜しくお願い申し上げます。

  • 印刷後のVBAの実行 (2)

    Private Sub Workbook_BeforePrint(Cancel As Boolean)   If ActiveSheet.Name = "Sheet1" Then     If Range("D6").Value = "" Then       Cancel = True       MsgBox ("名前を入力してください")       Range("D6").Select       Exit Sub     End If   Else     If ActiveSheet.Name = "Sheet2" Then       If Range("C11").Value = "" Then         Cancel = True         MsgBox ("受付時間を入力してください")         Range("C11").Select         Exit Sub       End If     Else              Exit Sub     End If   End If   ActiveSheet.Range("A70:Y70").Copy   If Worksheets("Sheet3").Range("A1").Value = "" Then     Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues   Else     Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _       Paste:=xlPasteValues   End If   Application.CutCopyMode = False   ActiveSheet.Range("A1").Select End Sub 先日、上記のコードを回答者の方から教えてもらい、とても助かっていますが sheet1のD5に「不要」という文字が入っていた場合、 sheet3への貼り付け(23~30行目の作業)をキャンセルして、最後にsheet1のA1を選択するようにはどの様にしたらいいでしょうか?

  • 複数シートの選択

    エクセルVBAで複数シートの選択をしたいのです。 シート名やシートの位置が変更される可能性があるので オブジェクトで指定したいのですが 記述方法が分かりません。 ##シートの位置 Sub mac1() Worksheets(Array(2,5)).Select End Sub ##シート名 Sub mac2() Worksheets(Array("aaa","あああ")).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のところが黄色くなります。 何処が間違えているのでしょうか。 全くの素人ですが、仕事で必要に迫られています。 わかりやすく回答・解説くれると助かります。

専門家に質問してみよう