VBAコードで指定範囲をコピーし貼り付ける方法について
- VBAコードを使用して、A2~A5, D2~D5, G2~G5のセルをコピーし、J2~P5に貼り付ける方法について教えてください。
- セル結合されているセルもありますが、その部分にも貼り付ける方法があれば教えてください。
- 環境はOffice 2013です。
- ベストアンサー
指定セルをコピー
A2~A5,D2~D5,G2~G5をコピーしJ~P列2~5行に値を貼付け続いて9~13行、16~20行もJ~P列に貼り付けたいのですが7~8,14~15行にはセル結合されているところもあります。VBAで下記コードを入力しましたがあまりにデータが多く何か良い方法VBAコードはありますか。(For~Nextなど使用すれば良いのでしょうか) 環境はoffice2013です。 Range("A2:A6").Select Selection.Copy Range("J2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D2:D6").Select Selection.Copy Range("M2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False
- kuma0220
- お礼率77% (279/361)
- Excel(エクセル)
- 回答数3
- ありがとう数3
- みんなの回答 (3)
- 専門家の回答
質問者が選んだベストアンサー
追加の質問は受け付けない主義なのですが(笑)。 どうしても回答が長くなってしまうので(笑)。 んで、アレもコレもとキリが無くなるので。 質問のその前に、ご自身で色々試してみると良いですよ。 上書きしなければ元に戻せるんですから。 で、前の回答でのコードをよく読んで理解なさると良いですよ。 じゃないと先に進めませんから。 とりあえず。 > A,B列をJ,K列に 手作業でやる時ってどうされますか? 元の添付図で言うなら例えば ・A2:B6を範囲指定して、コピー ・J2セルにフォーカスを移し、貼り付け でできますよね。 これを「マクロの記録」してやると Range("A2:B6").Select Selection.Copy Range("J2").Select ' 「どこのセルを先頭に」の指定も可能 ActiveSheet.Paste Application.CutCopyMode = False こう録れますね。(単純な貼り付けの例ですが。) つまり前の回答の「可能性2」のソレを Range("どこのセルから", "どこのセルまで").Copy Cells(どこのセルを先頭に).PasteSpecial Paste:=xlPasteValues に変えてやれば良さそうですね。 (というか、そのように書いたつもりでしたけどね。) よって、 Range(Cells(i, j), Cells(i + 4, j + 1)).Copy と打ち直してやれば良さそうです。 で、前の回答はそもそも「3行おき」ですのでそこは割愛。 > ”A2:G20”が1ブロックで次のブロックが5行空いた場合 日本語的に「読めばわかる」範囲の話のような気がします。 前の回答中の For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Step 7 '行は7行おき の意味をお考え下さい。 「行は」と注釈を入れている以上、 この変数「i」を「行番号の素」として使うのだろう、と思いませんか? 上記は「2行目から初めて7行おきにデータが無くなるまで」の意味です。 これを 2行目から20行目まで⇒19行 + 5行おき なのだから「24行おき」に置き換えてやれば良いだけです。 つまり For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Step 24 ですね。 範囲の指定は前述の通りなので「以下同文につき省略」。 あとはご自身で少し考えてみてくださいませ。
その他の回答 (2)
- tsubu-yuki
- ベストアンサー率46% (179/386)
「添付図を見る限り」だと私も同様に Columns("A:G").Copy Range("J1").PasteSpecial Paste:=xlPasteValues 'Application.CutCopyMode = False 'ココ、ほんとは不要 Range("K:L,N:O").ClearContents A~G列を一気にコピーしちゃって、 要らない列を消去(削除じゃないですよ)したらどうでしょ?なのですが。 問題は > 7~8,14~15行にはセル結合されているところもあります コレのおかげで「列全体消去できないよ」ってことでしょうか。 解消できる可能性がある力業を2通り。 可能性1) 一回結合を解除、要らない列を消去して、 転記元の列の「書式」をコピー・貼り付け Columns("A:G").Copy Range("J1").PasteSpecial Paste:=xlPasteValues ' 値を貼り付け Columns("J:P").UnMerge ' 結合解除 Range("K:L,N:O").ClearContents ' 該当列消去 Columns("A:G").Copy ' 再度コピー Range("J1").PasteSpecial Paste:=xlPasteFormats ' 書式を貼り付け Application.CutCopyMode = False 可能性2) 本当に必要なところだけコピー・貼り付け おっしゃる通り、簡単なのはFor~Next。 For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Step 7 '行は7行おき For J = 1 To 7 Step 3 ' 列は3列おき Range(Cells(i, j), Cells(i + 4, j)).Copy Cells(i, j + 9).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False Next j Next i おそらく、コレでなんとか。 とりあえず、2通り。 コレら以外なら補足くださいませ。 ここに直接手打ちなので、スペースの位置とか違うかもです。 で、我流ですが、スッキリ書くアドバイス。 1).Select ~~ Selection. 必要な場面もありますが、ほとんどの場合は省略できます。 例示だと Range("D2:D6").Select ' ココを選択して Selection.Copy ' 選択されたところをコピー ↓ Range("D2:D6").Copy 'ココをコピー で通ります。 カナ混じり日本語で見てもスッキリですね。 必要・不要、色々お試しくださいませ。 2)要らないオプションは省略 この例示の場合、貼り付けのオプションですね。 初期値のままで良い場合や特にいじる必要が無いときは省略しちゃいます。 良ければ、エクセル本体でとりあえず何かをコピーし、 右クリック→形式を選択して貼り付け でダイアログを出して、 眺めながらご確認ください。 ・Paste ⇒ 「貼り付け」の欄に対応 コレは省略しない方が良いかも。 ・Operation ⇒ 「演算」の欄に対応 今回は必要ない・・かな。 ・SkipBlanks ⇒ 「空白を無視する」のチェック 必要ないでしょう。 ・Transpose ⇒ 「行列を入れ替える」 必要無いですな。 ということで、必要ないところは省略します。 Range("M2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False ↓ Range("M2").PasteSpecial Paste:=xlPasteValues はぃ、スッキリしました。
補足
ありがとうございます。大変勉強になりました。可能性2の応用で頑張っています。ご質問なんですけど現状A列をJ列にそれから3列おきに貼付けですがA,B列をJ,K列にD,E列をM,N列に貼付けなど複数列を指定し列おきに貼付けできますか。また”A2:G20”が1ブロックで次のブロックが5行空いた場合ブロックの範囲指定も可能でしょうか。申し訳ありませんがご教授のほど宜しくお願いします。
- imogasi
- ベストアンサー率27% (4737/17068)
質問表現がコードと画像に頼りすぎて、下記でよい(十分)かどうか判断できない。 色んな場合の(表や値の)バラエティは、質問者にしかわからない。 画像例もあくまで簡略化しているかもしれず、すべての状況(セルの値などのセル的な配置状況)が説明されていない。文章で工夫するしかないだろうが、画像の方が完全と思っている質問者が多いので回答に困る。 下記回答なども、21行より下の方に別の表があれば、直ちにアウトだが。 1ブロックだけで例にすると)(実際はもっと表があるのかもしれないが) 一旦コピーして、不要な列のデータを消す方法を考えた。これでよいか。 Sub test01() With Sheet1 .Range("a2:G20").Copy Range("j2") Range("k:K, L:L, N:N,O:O").Clear End With 参考 離れた列を選択 http://www.tipsfound.com/vba/09004 End Sub
お礼
ありがとうございます。勉強になりました。
関連する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
- ベストアンサー
- オフィス系ソフト
- 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位まで変動します 一連の動作をコピーして手作業で数字を変えてみたのですが プロージャが大きすぎてエラーになってしまいます。 何か良い方法は無いでしょうか?。
- ベストアンサー
- オフィス系ソフト
- 色々なものを見ながら作っている初心者です。
色々なものを見ながら作っている初心者です。 よろしくお願いします。 VBAでのエラー対処について 下記のマクロを実行すると、実行時 「Selection.Resize(, Selection.Columns.Count - 2).Select」のところで セルがブランクだった時にエラーが出てします。 対処の方法を教えていただけませんでしょうか? よろしくお願いします。 Sheets("sheetB1").Select Range("A7:C161").Select Application.CutCopyMode = False Selection.ClearContents Sheets("sheetA").Select Range("D12").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToLeft)).Select Selection.Resize(, Selection.Columns.Count - 2).Select Selection.Offset(0, 1).Select Selection.Copy Sheets("sheetB1").Select Range("A7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetA").Select Range("E12").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("B1").Select Range("C7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetB2").Select Range("A7:C161").Select Application.CutCopyMode = False Selection.ClearContents Sheets("sheetA").Select Range("J12").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToLeft)).Select Selection.Resize(, Selection.Columns.Count - 2).Select Selection.Offset(0, 1).Select Selection.Copy Sheets("sheetB2").Select Range("A7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetA").Select Range("K12").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("steetB2").Select Range("C7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=Fals
- 締切済み
- オフィス系ソフト
- EXCEL VBAで複数行のコピー(バックグランド)
EXCELのVBAで質問します。 複数行をコピーしてPasteを行う方法がわかりません。 フォアグランドでは正しく実行できるのですが、バックグランドで実行した場合は、1行しかPasteできません。 お分かりの方いらっしゃれば教えてください。 コードは以下のとおりです。 Sheets(\"DATA\").Select Range(\"A3:W26\").Select Selection.Copy Range(\"A4\").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True 宜しくお願いします。
- ベストアンサー
- Visual Basic
- マクロについて教えてください
マクロの超初心者です。 数式を入力しているのではなく、配付物をエクセルで作成しているのですが、同じもの(氏名や項目は違いますが)を100枚ほど作成しているのでマクロを・・・と思ったのですがやり方が全く分かりません。 sheet1からsheet2に下記のようにデータを写したいのですが、やり方を教えてください。 ●氏名が入力されています sheet1(A9) → sheet2(C2) sheet1(E9) → sheet2(C5) sheet1(I9) → sheet2(C8) ●項目1 sheet1(A8) → sheet2(E3) sheet1(E8) → sheet2(E6) sheet1(I8) → sheet2(E9) ●項目2 sheet1(A18~D18の結合セル) → sheet2(E2) sheet1(E18~H18の結合セル) → sheet2(E5) sheet1(I18~L18の結合セル) → sheet2(E8) と反映させたいのですが、250行あるのですが、 簡単にマクロで出来ないでしょうか?? ちなみに↓コレが上記の内容で作ってみたものです。 わかりずらい質問でスイマセン。 Range("A9").Select Selection.Copy Sheets("sheet2").Select Range("C2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E3").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E6").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E9").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A18:D18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E18:H18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I18:L18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False End Sub
- ベストアンサー
- その他(プログラミング・開発)
- エクセルVBA での繰り返し処理について
エクセルVBA での繰り返し処理について 以下の作業を20回繰り返そうとしています(別シートから持ってきた値を「行列を入れ替えて」貼り付け) Sheets("初期設定").Select Range("A6:C6").Select Selection.Copy Sheets(TS).Select Range("B4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True 「初期設定」シートの方は1行ずつ並んでいるので、「2回目」の「2行目」は 「 Range("A7:C7").Select」になり、 「TS」シートの20行後に貼り付けたいので、「2回目」の「5行目」は 「Range("B24").Select」 になります これを、for ~ next を使い、以下のようにしてみましたが、上手くいきません。 For j = 6 To 26 For k = 4 To 384 Step 20 Sheets("初期設定").Select Range(Cells(j, 1), Cells(j, 3)).Select Selection.Copy Sheets(TS).Select Cells(k, 2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True Next k Next j 1分程度ループし続けた後、「初期設定」シートの最終行だけが貼り付けられてしまいました。 どこをどのように直せばいいのかお教えください。 よろしくお願いいたします。
- ベストアンサー
- その他MS Office製品
- vba 不揃いの行数にカーソル位置対応
os_xp //// ex_2003 Sub goo() ' goo Macro ' Keyboard Shortcut: Ctrl+g ' Range("A65524").Select Selection.End(xlUp).Select Rows("669:669").Select '(1)-----次回及び 他のシートは不揃いの為 Selection.Copy Rows("670:670").Select '(2)-----(1)が位置が変化するからここも対応 ActiveSheet.Paste Application.CutCopyMode = False Range("A669:F669").Select '-----範囲の変更ありの予定 Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveSheet.Paste Application.CutCopyMode = False Range("BD669:BG669").Select '-----範囲の変更ありの予定 Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveSheet.Paste Application.CutCopyMode = False Range("A672").Select '(3)-----次回及び 他のシートは不揃いの為 最後に記録の2段下にカーソルが来て欲しい End Sub ' 'どのシートでも (1) (2) (3) が対応してくれないか?。 '
- ベストアンサー
- オフィス系ソフト
- エクセルのマクロ 選択したセルを指定した範囲へ値貼
お世話になります。 自動記録したものをどのように修正したら、実行時に選択しているセルの値を、3行下、1つ左のセルから8行目までに貼り付けることができるよう書き変えられますでしょうか。 初心者で何に手を付けて良いのか分からず。どなたかご教示いただけませんでしょうか。どうぞよろしくお願い致します。 Sub 選択したセルを指定した範囲へ値貼り付け() ' ' Macro1 Macro ' ' Range("I9").Select Selection.Copy Range("H12:H19").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub
- ベストアンサー
- Excel(エクセル)
- VBA マクロ実行時エラー’1004RangeクラスのPasteSpecialメソッドが失敗
マクロ実行時に、エラー’1004RangeクラスのPasteSpecialメソッドが失敗と表記され、マクロが実行されません。 マクロの内容は、任意の範囲をコピー、新規book追加し、 新規bookに(1)Paste:=xlPasteValues (2)Paste:=xlPasteColumnWidths (3)Paste:=xlPasteFormats の順に貼り付けし保存するものです。 いろいろ調べては見たのですが、当方初心者の為、わからずじまいです。お手数ではございますが、どなたかご教授願います。 下記にマクロ内容全部記載します。 よろしくお願いします。 ********************************************************* ********************************************************* Sub 日報別ファイルに保存したい1() Worksheets("日報").Range("A3:AF36").Copy With Workbooks.Add Cells.Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Cells.Select Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Range("A1").Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False ApplicationDisplayAlerts = True '同名FILEが存在する場合' ActiveWorkbook.SaveAs Filename:= _ "c:\日報\" & ActiveSheet.Range("J2") & "年" & ActiveSheet.Range("l2") & "月" & ActiveSheet.Range("n2") & "日_日報.xls" _ , FileFormat:=xlNormal .Close file End With End Sub
- ベストアンサー
- オフィス系ソフト
- 「elseに対応するifがありません」と表示されます。
If Range("a2") > 0 Then GoTo saisyo Else End End If saisyo: Range("a2").Select.Copy Range("B2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub とすると、質問タイトルのエラーが出ます。何がいけないのでしょうか?
- ベストアンサー
- オフィス系ソフト
お礼
補足回答まで頂きありがとうございます。コード説明があり非常に助かりました。コード打込み変更により各処理ができ納得しました。大変ありがとうございました。