VBAでセル範囲のコピーを行う方法
- VBAを使用して指定のセル範囲をコピーする方法について説明します。
- 具体的には、B4セルからI33セルまでの範囲をコピーし、J4セルとR4セルに貼り付けます。
- ただし、jpg画像ファイルではなく、図形の円のみを貼り付ける方法を示します。
- ベストアンサー
VBA セル範囲コピー 図形のみ
現在下記コードで指定のセル範囲のコピーをしています。 B4セルからI33セル範囲内にはjpg画像ファイルと そのjpgファイルに印をする為、図形の円があります。 円は複数ありjpgファイルに重なっています。 今回行いたのは、B4セルからI33セルをコピーして J4、R4セルに貼り付ける際に jpgファイルは貼り付けないで、図形の円のみを貼り付けしたいです。 宜しくお願いします。 Sub セルコピー() Range("B4:I33").Select Range("I33").Activate Selection.Copy Range("J4").Select ActiveSheet.Paste Range("R4").Select ActiveSheet.Paste Application.CutCopyMode = False End Sub
- yyrd0421
- お礼率50% (86/170)
- Excel（エクセル）
- 回答数1
- ありがとう数2
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
jpg ファイルは貼り付けないで、図形の円のみを貼り付け 不可能ではないと思いますが、難しすぎます。 全てコピーした後、画像を消したほうが手っ取り早いです。 ' Sub AutoShapeCopy() ' コピペの後画像を削除 Dim OldCount As Integer Dim Count As Integer ' OldCount = ActiveSheet.Shapes.Count + 1 [B4:I33].Copy [J4] [B4:I33].Copy [R4] ' For Count = ActiveSheet.Shapes.Count To OldCount Step -1 ' If ActiveSheet.Shapes(Count).Type = msoPicture Then ActiveSheet.Shapes(Count).Delete End If Next Count End Sub なお、コピーも変えました。マクロの記録を使うと、あのように長くなりますが、この書き方なら１行で済むし、一目でわかります。
関連するQ&A
- VBAマクロ_セル範囲を行列番号で指定
エクセルマクロで、ある範囲を指定してコピーし、別の場所を指定してそこへ貼付たいのです。 個別に指定するなら、例えばこんな感じで Range("B18:C32").Select Selection.Copy Range("B67").Select ActiveSheet.Paste B18:C32 のように、セル番号で指定すれば出来ます。 このコピー範囲を、行列番号で指定したいのです。 「セル（i,j)～(k,l)までの範囲」というふうに、4つの変数で表現したいのです。 cells(i,j)を使えばできそうと思ったのですが、どうもうまくいきません。 良いやり方があれば教えてください。
- ベストアンサー
- その他MS Office製品
- やはり図形のクリアで実行時エラー1004
図形を二行三列で一枡とし図形を貼り付けていますが、どうしても実行時エラー 「1004」が出て図形のクリアができません。(尚、四角形は枠線上にあります。) 対処法がありましたらお願いします。 Windows7・SP1 Office2010 Sub 図形の貼付け() Dim i As Integer Dim j As Integer For i = 10 To 43 Step 2 For j = 9 To 99 Step 3 Select Case Cells(i, j).Value Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste Case 2: ActiveSheet.Shapes("四角形2").Select Selection.Copy Cells(i + 1, j).Select ActiveSheet.Paste Case 4: ActiveSheet.Shapes("四角形3").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste Case 5: ActiveSheet.Shapes("四角形3").Select Selection.Copy Cells(i + 1, j + 2).Select ActiveSheet.Paste Case 6: ActiveSheet.Shapes("円1").Select Selection.Copy Cells(i, j).Select ActiveSheet.Paste End Select Next Next End Select End Sub Sub 図形のクリア() Dim myRng As Range Set myRng = Range("I10:CW43") Dim n As Integer, sp As Variant For n = ActiveSheet.Shapes.Count To 1 Step -1 Set sp = ActiveSheet.Shapes(n) If Not Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), myRng) Is Nothing (ここで実行時エラー1004になります。) Then sp.Delete End If Next Set myRng = Nothing End Sub
- ベストアンサー
- Visual Basic
- エクセルの図形移動で困っています。
エクセルの図形移動で困っています。 シート２にある図形をシート１にマクロを使って移動（コピー＆貼り付け）をしようとしています。 マクロの記録でやった所、以下のような感じになりました。 Sub Macro4() ' ' Macro4 Macro ' ' Sheets("sheet2").Select Selection.Copy Sheets("sheet1").Select Range("N16").Select ActiveSheet.Paste End Sub しかし、なぜか３回程つかうとシート１に貼り付けされなくなります。 原因はシート２の図形をコピーする時に選択されるところがないからではないか？と思い 色々ネットで調べてみたのですが、まだまだ結論が出ていない状態です。 皆様のお力を貸して頂ければと思います。 Sub Macro4() ' ' Macro4 Macro ' ' Sheets("sheet2").Select (たぶんここに"図形1）とか入るのでは？？と思っています Selection.Copy Sheets("sheet1").Select Range("N16").Select ActiveSheet.Paste End Sub
- ベストアンサー
- Microsoft ASP
- エクセルVBAでコピーすると行の高さが低くなる
いつもお世話になってます。 エクセル２００３のVBAで、セルの範囲を指定してコピーすると行の高さが低くなってしまいます。その他の書式は、変化せずうまくコピーできています。以下がプログラムです。 Sub copy_hyou() Worksheets("sheet1").Activate Range("A1:K24").Copy 'セルA1からK24をコピーします。 Range("A25").Select 'A25からペイストします。 ActiveSheet.Paste End Sub どう直せば、行の高さもコピーできるでしょうか？ お休み中すみませんがよろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- 図形のコピーとコピー先のセル・行幅の設定について
ユーザーフォームで「シートの追加」ボタンを押と、新しいシートが挿入されるという設定です。 このとき、フォーマットとなる表や文字は Range("A1", "CA56").Select Selection.Copy Sheets.Add.name = "二枚目のシート" ActiveSheet.Range("A1").Select Selection.PasteSpecial Paste:=xlPasteAll を使い、貼り付けることが出来ました。てっきりxlPasteAllで、図もコピーできると思っていたら、 吹き出しや、楕円等のエクセルのオートシェイプ機能を使って作った図形が一緒にコピーできません。 図形は20個ほどあり、同じ位置にすべて貼り付けたいと思っています。そもそも無理なのでしょか？お力を貸してください。 またコピー先のシートのセルの幅と行の幅がコピー元と変わってしまいます。 細かい設定をすることは可能でしょうか？よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- 図形 Selectionが省略できない VBA
「タイトル」という名の図形はシート上に存在するのですが、 Sub a() ActiveSheet.Shapes.Range(Array("タイトル")).ShapeRange.Height = 110 End Sub Sub b() ActiveSheet.Shapes.Range(Array("タイトル")).Select Selection.ShapeRange.Height = 110 End Sub aだとエラーになりますが、 bだと正常に動きます。 SelectやSelectionは省略できるものだと思ってるのですが なぜaだとエラーになるのでしょうか？ 一度図形をアクティブにする動作が必要なのですか？
- ベストアンサー
- オフィス系ソフト
- ＥＸＣＥＬ ＶＢＡ セルからファイル名を読み込む
EXCEL ＶＢＡについての質問です 同じ処理を名前の違う複数のファイルで行いたいと思っています そこで、セルＡ２へファイル名の『○○.xls』○○部分だけをそれぞれのファイルに書き込んでおき、マクロは共通にしてファイル名をそれぞれのファイルから読み込んで実行したいと思っています。 良い方法を教えてください。 Workbooks("200809.csv").Activate Sheets("200809").Select Range("C3:C33").Copy Windows("○○.xls").Activate'←ここをファイルにあわせて変更できる形にしたい Sheets("報告書").Select Range("G5:G35").Select ActiveSheet.Paste Windows("200809.csv").Activate Range("K3:K33").Copy Windows("○○.xls").Activate’←ここ Sheets("報告書").Select Range("I5:I35").Select ActiveSheet.Paste Workbooks("200809.csv").Close SaveChanges:=False よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- マクロ 可視セルへコピーする方法
こんにちは。よろしくお願いします。 Ａ～Ｖ列、300～400行程度の表を作っています。 8行目をコピーして空白行へペーストしたいのですがどのようにすれば良いでしょうか。 マクロの記録でつくったものは ActiveSheet.Paste でエラーになります。 またペースト開始行をA17ではなくて可変なものに変えたいです。 よろしくお願いします。 Sub 下までコピー() Range("A8:V8").Select Selection.Copy Selection.AutoFilter Field:=2, Criteria1:="=" Range("A17:V" & Range("B5").End(xlDown).Row).Select Selection.SpecialCells(xlCellTypeVisible).Select ActiveSheet.Paste Application.CutCopyMode = False Selection.AutoFilter Field:=2 End Sub
- 締切済み
- オフィス系ソフト
- 図形をコピーするマクロ
Sheets("Sheet1").Select ActiveSheet.Shapes("図 1").Select Selection.Copy Sheets("Sheet3").Select Range("E9").Select ActiveSheet.Paste 上記は、"Sheet1"の"図1"を、"Sheet3"の"E9"にコピーするマクロです。 これを改良して、Sheet1以外のシートがアクティブになっている時に実行すると、"Sheet1"の"図1"が、現在アクティブになっているシートのセレクトされているセルにコピーされるようにしたいのですが。 どのようにマクロを変えればいいでしょうか。
- ベストアンサー
- オフィス系ソフト
- Excelでセル上の画像を別のセルにコピーするには
いつも楽しく勉強させていただいております。 つぎのような処理をしたいのですが、うまくいきません。 １．セル１の上にある画像をセル２の上にコピーする。 ２．コピーした画像をセル２の高さと幅にフィットさせる。 まず、このようなマクロを考えてみました。 Range("A1").CopyPicture Range("C1").Select ActiveSheet.Paste ActiveSheet.Shapes(Selection.Name).LockAspectRatio = msoFalse ActiveSheet.Shapes(Selection.Name).Top = Range("C1").Top ActiveSheet.Shapes(Selection.Name).Left = Range("C1").Left ActiveSheet.Shapes(Selection.Name).Height = Range("C1").Height ActiveSheet.Shapes(Selection.Name).Width = Range("C1").Width これですと元の画像がA1のセルより小さい場合、周囲に余白がある形でコピーされてしまいます。 C1にコピーしたら余白はなしでC1の大きさいっぱいに画像を引き延ばしたい（あるいは縮小したい）のです。 そこで次のように変更してみました。 （上のプログラムと一番上の行のみが違います）。 ActiveSheet.Shapes("図 6").Copy Range("C1").Select ActiveSheet.Paste ActiveSheet.Shapes(Selection.Name).LockAspectRatio = msoFalse ActiveSheet.Shapes(Selection.Name).Top = Range("C1").Top ActiveSheet.Shapes(Selection.Name).Left = Range("C1").Left ActiveSheet.Shapes(Selection.Name).Height = Range("C1").Height ActiveSheet.Shapes(Selection.Name).Width = Range("C1").Width これもうまくいきません。 A1にある元の"図 6"は動かしたくないのに、勝手にB1の位置に移動してしまいます。 というのは、"図 6"という画像をコピーすると、同じ名前で画像ができちゃうんですね。 コピー元とコピー先の両方の画像に対して位置や高さを設定することになるようです。 ということで、 １．セル１の上にある画像をセル２の上にコピーする。 ２．コピーした画像をセル２の高さと幅にフィットさせる。 これを実現させるにはどうしたらいいでしょう。
- ベストアンサー
- その他MS Office製品
お礼
返信が遅くなってしまいすみません。 本日会社の方で頂いたコードを試すことができました。 理想通りの事ができました。 大変ありがとうございました。