• ベストアンサー

エクセル VBA 各シートに貼り付け

いつも皆様には大変お世話になっております。 表題に書いたようにコピーしたものを貼り付けしたいのですがうまく動きません。 Sheets("A").Select Range("B8:B38").Select Selection.Copy For Each sh In Worksheets If sh.Name <> "A" Then Range("B12:B42").Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Range("F38").Select ActiveWindow.SmallScroll Down:=-12 End If Next と言った様な構文を書いているのですが Aのファイル内のみでコピーして貼り付けをやってしまいます。 ちなみにシートはB,C,Dなど各種あります。 よろしくお願いいたします。

  • nanny
  • お礼率55% (72/129)

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

  • ベストアンサー
  • KenKen_SP
  • ベストアンサー率62% (785/1258)
回答No.1

Range("B12:B42").PasteSpecial ~ だと、いくら For Each ループで回しても現在アクティブなシートの B12:B42 に貼り付け続けることになります。 直前にアクティブシートを切り替えるか、以下のように   「どのシートの Range か?」 を指定してやれば良いでしょう。     Dim Sh As Worksheet      Sheets("A").Range("B8:B38").Copy   For Each Sh In Worksheets     If Sh.Name <> "A" Then       Sh.Range("B12:B42").PasteSpecial Paste:=xlPasteFormats     End If   Next

nanny
質問者

お礼

早速のお返事ありがとうございます Dimの指定が必要だったのですね・・・ う~ん 色々試しているのですがなかなかにおくが深いですね・・・ 早速試してみます。ありがとうございました

その他の回答 (1)

  • hana-hana3
  • ベストアンサー率31% (4940/15541)
回答No.2

>Aのファイル内のみでコピーして貼り付けをやってしまいます。 For Each を使ってシートを取得していますが、式の内部でシートを指定していないからです。 sh.Activate とか、 sh.Range("B12:B42").xxx 等と、作業シートを指定する必要があります。 Sub test1() Dim sh Sheets("A").Select Range("B8:B38").Copy For Each sh In Worksheets If sh.Name <> "A" Then sh.Activate Range("B12:B42").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Range("F38").Select ActiveWindow.SmallScroll Down:=-12 End If Next End Sub

nanny
質問者

お礼

早速のお返事ありがとうございます Dim意外と大事ですね・・・ もうちょっと勉強してがんばります。

関連するQ&A

  • エクセルマクロ 繰り返して、別のシートへコピーしたい

    エクセルマクロ 繰り返して、別のシートへコピーしたい マクロ初心者のため、やり方が全くわかりません。 どなたか教えてください。 やりたいことは、 コピーするシートはあらかじめ作成しています。 簡素化の方法がわからないので、 とりあえず自分で作ってみたものが下にあるものです。 繰り返す方法がわからないので、 どなたか教えてください。 よろしくお願いします。 以下、作成したマクロです。 1行目から10行目まで繰り返したくて、 1行目から2行目のセルの移動の差は10行目までかわりません。 '1行目 Sheets("Sheet1").Select Range("B14:C14").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Sheets("Sheet1").Select Range("B15:C17").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("B1").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False '2行目 Sheets("Sheet1").Select Range("B18:C18").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("A2").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Sheets("Sheet1").Select Range("B19:C21").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("B2").Select Range("B2").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False

  • こんなマクロなんですが。

    下記のマクロでエクセルの表からデータ(文字列)を取得するようにしたいとおもっています。 Range("B23").Select Selection.Copy Range("F23").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("B24").Select Selection.Copy Range("F24").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("B25").Select Application.CutCopyMode = False Sheets("September 03").Copy Before:=Sheets(2)          ←ここ Selection.Copy Sheets("September 03 (2)").Select                   ←ここ Sheets("September 03 (2)").Name = "September 10"       ←ここ Range("B33").Select Application.CutCopyMode = False ActiveWindow.SmallScroll Down:=-15 Range("F12:L18").SelectEnd Sub と、まだ続くんですが、とりあえずここまでで。 番地のデータを取り込むようにしたいんですが、うまくいきません。 ←ここ っていうのがまさにそれです。

  • エクセルマクロの解説をお願いします!

    マクロ勉強中の初心者です。度々質問させていただいてます。 下記はあるマクロの抜粋なのですが、何をしているのか、何を表しているのかがわかりません。 一応途中までは自分なりに解釈してみたのですが、この部分は解読不能でした。どうかお力をお貸しください。   Dim a As Integer   a = Range("A65536").End(xlUp).Row ActiveWindow.SmallScroll Down:=-18 Columns("A:A").Select Range("A" & a).Activate Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SmallScroll Down:=-12

  • Excelでマクロを繰り返したい。

    Excelでマクロを記録したら以下のようになりました このマクロを以下の条件で繰り返したいのですが。 Sub Macro1() '------------- '----------------------- ' Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=5*", Operator:=xlAnd, _ Criteria2:="<>5@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=6*", Operator:=xlAnd, _ Criteria2:="<>6@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=7*", Operator:=xlAnd, _ Criteria2:="<>7@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=8*", Operator:=xlAnd, _ Criteria2:="<>8@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub 条件= Field:は4~35位まで変動します 一連の動作をコピーして手作業で数字を変えてみたのですが プロージャが大きすぎてエラーになってしまいます。 何か良い方法は無いでしょうか?。

  • Excel macro 同じ作業を全シートで実行

    お世話になります。 下記のマクロを作成してみましたが、最初のシートで実行後、次のシートには移らないです。何かを見落としているには違いないですが。。。 誰かにご教示いただければ。。。 Sub Macro4() ' Dim sh As Object For Each sh In Worksheets Range("H3").Select Selection.Copy Range("BA3").Select ActiveSheet.Paste Range("BA3:BD3").Select Selection.ClearComments Range("BA5").Select Selection.Copy Range("AZ3:BE3").Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Range("BA3").Select Selection.TextToColumns Destination:=Range("BA3"), DataType:=xlFixedWidth, _ FieldInfo:=Array(Array(0, 2), Array(6, 2)), TrailingMinusNumbers:=True Next For Each sh In ActiveWindow.SelectedSheets sh.Activate sh.Name = Range("BB3") Range("BA3:BB3").Select Application.CutCopyMode = False Selection.ClearContents Next End Sub 宜しくお願いします。

  • Excelのマクロ 検索範囲を広げたい

    マクロ初心者です。 マクロが入ってるExcelファイルがあるのですが、 マクロボタンを押しても結果がでないので、たぶんマクロの検索範囲が1列しかなってないみたいなので広げたいのですが、どうしたらよいでしょうか? Sub 検索準備() ' ' 検索準備 Macro ' ' Sheets("データ表").Select Range("A3:ES2002").Select Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin, DataOption1:=xlSortNormal Sheets("検索表").Select Range("A4").Select ActiveCell.FormulaR1C1 = "=+R[1]C" Range("A4").Select Selection.Copy Range("B4:ES4").Select Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Sheets("個人スキル").Select Range("D3:E3").Select End Sub Sub スキル検索() ' ' スキル検索 Macro ' ' ' Sheets("検索表").Select Range("A4:ES4").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1:ES4").Select Application.CutCopyMode = False Selection.Copy Sheets("計算表").Select ActiveWindow.SmallScroll ToRight:=-3 Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True Range("F1:J149").Select Application.CutCopyMode = False Selection.Copy Range("L1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SmallScroll ToRight:=4 Range("L13:P149").Select Application.CutCopyMode = False Selection.Sort Key1:=Range("L13"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin, DataOption1:=xlSortNormal Range("L23").Select Sheets("個人スキル").Select Range("D3:E3").Select End Sub 検索準備ボタンと、スキル検索2種類ボタンがあります。 どこをいじくればよいのか分かりません。 検索表の検索範囲が表題を抜かして人の名前などが入ってる列が1列しかなってないので・・・

  • エクセルVBAで値の貼り付けができない

    色々調べたのですが、出来ない理由が見つけられません。よろしくお願い致します。 計算式の入っているセルをマクロで貼り付けしようと思っているのですが、 貼り付ける際、値の貼り付けにしたいのです。 下記の通りすると計算式のまま貼り付けされてしまいます。 どなたか教えて下さい。お願い致します。 Selection.Copy wsKei.Select wsKei.Range("A" & intLinekeistr & ":A" & intLinekei - 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False エクセルは、2007 PCはvistaです。

  • エクセルマクロVBAについて

    エクセルマクロVBAについて、こんなこと出来ますか? ■A列からAS列の1行目にヘッダー情報をもつデータベース ■A列に担当者名 ■A列にオートフィルタをかけて各担当ごとにデータを抽出したものを別シートに貼り付けて自動印刷したい ■担当者は都度変わるので、Criteria1:="xxx"というようには直接書けない(担当名を自動で抽出したい) ■担当者の数も都度変わる ■補足 一行のデータを特定の雛形に転記する必要があるので別シートに出したいです ちなみに、アナログで記録したコードは以下です。 Sub test1() Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="山田" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="斉藤" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="田中" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 End Sub これ、担当者の抽出を自動でなんとかなりませんか?

  • 実行時エラーについて

    Konkon_mと申します よろしくお願いします エクセルの質問なんですが、今回ワークシートから別のワークシートに表と数値を貼り付けるマクロを作成したのですが終了時に、『実行時エラー'1004' WorksheetクラスのPasteメソッドが失敗しました』のエラーがでるのです 一応、コピー&貼り付けはきちんと終了しているようなのですがすごく気になります 作成したマクロを載せますので、わかる方がいらっしゃいましたら教えていただけないでしょうか? 宜しくお願いします ChDir "H:\A\B" Workbooks.Open FileName:="\\PRO800\Home Directory\B\B\コピー.xls" ActiveWindow.WindowState = xlMinimized Range("B3:D10").Select Selection.Copy ActiveWindow.WindowState = xlMinimized ActiveWindow.WindowState = xlNormal ActiveWindow.WindowState = xlMinimized Windows("コピー.xls").Activate ActiveWindow.WindowState = xlNormal Range("B3").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("B3:D10").Select Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("A1").Select ActiveWorkbook.Save ActiveWindow.Close ActiveWindow.WindowState = xlNormal Range("B3").Select ActiveSheet.Paste Application.CutCopyMode = False Range("A3").Select ActiveWindow.WindowState = xlMaximized End Sub

  • エクセル VBA 繰り返し処理を 簡潔にしたいのでお願いします。

    初心者です。繰り返し処理のシート名操作が分かりません。 上手く説明できないのですが、シートの名前が数字の1~20で 特定のセルを参照してテーブルにします。 現在、とても単純なコードを繰り返しています。 すっきりとさせるには、どのように記載するとよいのか 教えてください。 以下の処理を20回ほど繰り返します。  'シート1の特定セルをコピーします Sheets("1").Range("c3").Copy Range("A3").PasteSpecial Sheets("1").Range("c4").Copy Range("B3").PasteSpecial Sheets("1").Range("o2").Copy Range("C3").PasteSpecial Sheets("1").Range("o3").Copy Range("D3").PasteSpecial Sheets("1").Range("Q6:Q42").Copy Sheets("集計").Select ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range("E3").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True 'シート2の特定セルをコピーします Sheets("2").Range("c3").Copy Range("A4").PasteSpecial Sheets("2").Range("c4").Copy Range("B4").PasteSpecial Sheets("2").Range("o2").Copy Range("c4").PasteSpecial Sheets("2").Range("o3").Copy Range("d4").PasteSpecial Sheets("2").Range("Q6:Q42").Copy Sheets("集計").Select ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range("E4").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Sheets("3").Range("c3").Copy Range("A5").PasteSpecial Sheets("3").Range("c4").Copy Range("B5").PasteSpecial Sheets("3").Range("o2").Copy Range("c5").PasteSpecial Sheets("3").Range("o3").Copy Range("d5").PasteSpecial Sheets("3").Range("Q6:Q42").Copy Sheets("集計").Select ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range("E5").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True

専門家に質問してみよう