いつも活用させて頂いております。

excelのvbaで、コピー元のセルを範囲指定して、ペーストするロジックを書いています。
コピー元のセルには、コントロール(テキストボックスなど)が配置されているのですが、これを一緒にコピー&ペーストする事はできないでしょうか?
一緒にできないのであれば、セルのコピー&ペーストのあとにコントロールのコピー&ペーストができるような方法があれば、ご教授願います。

よろしくお願い致します。

このQ&Aに関連する最新のQ&A

A 回答 (1件)

コントロールは編集モードならコピーできると思いますが、実行モードで普通にコピー&ペーストを行ってもできないと思われます。

素人の力技ですが下記マクロを作ってみました。おもしろい問題でけっこうはまってしまいました。
長くなるので選択状態のチェック等は行っていません。m(_ _)m
同一シートのみで可能です。標準モジュールに貼り付けます。
ショートカットキー Ctrl+Shift+A 等に割り当てて下さい。
コピー元を選択し、コントロールキーを押しながら貼り付け先の左上セルを選択します
順番は逆でもかまいません。複数セルが含まれる矩形セル範囲と単一のセルが指定されていることが要件です。
(これは単一セルと単一セルのコピーと他シートへのコピーは対応していません。)
参考にして下さい。

Public Sub ShapesCopy()
Dim rgCopy As Range 'コピー元セル範囲
Dim rgPaste As Range '貼り付けるセル(左上)
Dim rgShape As Range 'コピー元にあるコントロールの左上セル
Dim myShape As Object '1つのコントロール
Dim rowCopy, clmCopy As Long 'コピー元の左上セルの行、列番号
Dim rowPaste, clmPaste As Long '貼り付けるセルの行、列番号
Dim disRow, disClm As Long 'コピー元と貼り付け先の行・列の隔たり

'*** 選択セルをコピー元と貼り付け先に分離 ***
With Selection
If .Areas(1).Count = 1 Then
Set rgCopy = .Areas(2)
Set rgPaste = .Areas(1)
ElseIf .Areas(2).Count = 1 Then
Set rgCopy = .Areas(1)
Set rgPaste = .Areas(2)
Else
Exit Sub '厳重なチェックは省略しています。
End If
End With

'*** コピー元と貼り付け先の隔たりを計算 ***
rowCopy = rgCopy.Cells(1, 1).Row
clmCopy = rgCopy.Cells(1, 1).Column
rowPaste = rgPaste.Cells(1, 1).Row
clmPaste = rgPaste.Cells(1, 1).Column
disRow = rowPaste - rowCopy '行の隔たり
disClm = clmPaste - clmCopy '列の隔たり

'*** コピー実行 ***
'===== セル =====
rgCopy.Copy: rgPaste.Select: ActiveSheet.Paste
'===== コントロール =====
For Each myShape In ActiveSheet.Shapes 'シート内のコントロールを探す
Set rgShape = Range(myShape.TopLeftCell.Address)
If Union(rgCopy, rgShape).Address = rgCopy.Address Then
'コントロールの左上セルがコピー元内にある場合はコピーする
myShape.Copy
Range(rgShape.Address).Offset(disRow, disClm).Select
ActiveSheet.Paste
End If
Next
rgPaste.Select
End Sub
    • good
    • 0
この回答へのお礼

力作をありがとうございます。

せっかく作成していただいて申し訳ないのですが、
VBAでコピー範囲を選択してペーストしたら図も一緒にペーストされました。

そのソースをいかに示します。
Dim xl As Object
xl.Application.Sheets("TEMP").Range("A1:AN34").Copy xl.Application.Sheets("DATA").Range("A" & CStr(1 + 34 * TotalPage))

これで、TEMPシートのA1:AN34をコピーして、
DATAシートのA列(1 + 34 * TotalPage)行目にペーストしました。

私は別の方法でコピー&ペーストしていたのですが、
同僚がこのロジックで図のペーストができたというので試してみたら、本当にできました。

ご迷惑をおかけしました。
ありがとうございました。

お礼日時:2001/05/16 11:29

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qユーザープロファイルのコピーができない

Windows XP Professional で、ユーザープロファイルのコピーをしたいのですが、時々、うまくコピーができない事があります。原因として、どのような事が考えられるのでしょうか?また、回避策は、あるでしょうか?ちなみに、そのコピーできないユーザーアカウントへは、普通には、ログインできます。

【詳細】
ユーザープロファイルのコピーは、通常は、以下の方法で可能だと思います。
http://pasofaq.jp/controlpanel/nusrmgr/vistacopyprofile.htm
しかし、「ユーザープロファイル」のダイアログボックスが出ている状態で、コピーしたいプロファイルを選択すると[コピー先]ボタンが、灰色のままで、押すことができません。

Aベストアンサー

> ログオフして、その後に、Administratorで入りなおして
> いるのですが、それでも、コピーできないのです。
administratorでも、プロファイルには、セキュリティをかけて、
読めない状態にしている可能性があります。
プロパティを見て、一時所有者になり、アクセス許可を取らないと、
読めないと思われます。
共有のところが、セキュリティになっているのでは。

Q統合セルの混じった複数セルのコピー&ペーストがわかりません。

複数のセルのコピー、その後その情報を操作してペーストする方法がわかりません。

シート1にある情報は、

A1:E8は、1行づつ統合されています。A1:E1が統合されておりvalue=「1」、A2:E2が統合されておりvalue=「2」、・・A8:E8が統合されておりvalue=「8」、という具合です。
A9:E19は、統合されておらず、それぞれのセルに情報が入っています。
それらA1:E19を1単位として、右隣に同じ形式(2単位目はF1:J19)の情報が100個ほど並んでいます。

このシート1に対し、

Set IntTest = Application.InputBox(Prompt:="範囲をドラッグしてください。",Type:=8)

で「$A$1:$E$8,$B$9:$B$19」と入力したら、その情報をコピーして、別シート2のA列1列にそれらの情報をペーストしたいのです。その後次々に、シート1の入力した単位の隣の単位に対しても同じことをしていきたいのです。シート1の2単位目のF1:J19に対して、相対的に同じ部分をシート2のB列1列に貼り付け・・という具合に。

よろしくお願いします。

複数のセルのコピー、その後その情報を操作してペーストする方法がわかりません。

シート1にある情報は、

A1:E8は、1行づつ統合されています。A1:E1が統合されておりvalue=「1」、A2:E2が統合されておりvalue=「2」、・・A8:E8が統合されておりvalue=「8」、という具合です。
A9:E19は、統合されておらず、それぞれのセルに情報が入っています。
それらA1:E19を1単位として、右隣に同じ形式(2単位目はF1:J19)の情報が100個ほど並んでいます。

このシート1に対し、

Set IntTest = Applicat...続きを読む

Aベストアンサー

> A1:E19を1単位として、右隣に同じ形式(2単位目はF1:J19)の情報が
> 100個ほど並んでいます。

100 個というのが意味不明です。

A ~ E 列なら 1 単位辺り 5 列なので、100 単位となると 5 × 100 で
500 列必要になりますね。。Excel2007?

若しくは、5 列 × 20 単位 = 100 列 という意味ですか?

>「$A$1:$E$8,$B$9:$B$19」と入力したら、その情報をコピーして、
> 別シート2のA列1列にそれらの情報をペーストしたいのです。

仮に、「$A$1:$E$8,$B$9:$F$19」が選択された場合はどうします?


ポイントになりそうなのは、

  1. MergeArea
  2. Offset

ですかね。。働きはヘルプで調べてみて下さい。

結合セルの値は、結合セルの一番左角のセルから取得します。例えば
A1:C10 が結合されているなら A1、F10:J20 なら F10 のように。

ご希望の動作を正しく理解している自信がありませんが、とりあえず
テストコードということで回答してみます。

Sub macro()
  
  Dim Sh  As Worksheet
  Dim rSrc As Range
  Dim r   As Range
  Dim i   As Long
  Dim lRow As Long
  Dim lCol As Long

  Set rSrc = Application.InputBox( _
        Prompt:="範囲をドラッグしてください。", _
        Type:=8)
  If rSrc Is Nothing Then Exit Sub
  
  Set Sh = Worksheets.Add(After:=ActiveSheet)
  lRow = 1
  lCol = 1
  For i = 1 To 20
    For Each r In rSrc
      ' // MergeArea で取得されるセルの一番左角のセルであった時
      ' // のみ転記処理を行う。結合セルであるかどうかは問題ではない
      If r.Address = r.MergeArea(1).Address Then
        Sh.Cells(lRow, lCol).Value = r.Value
        lRow = lRow + 1
      End If
    Next
    ' // 1単位は 5 列で構成されるので、次の単位における
    ' // 同位置は Offset(0,5)
    Set rSrc = rSrc.Offset(0, 5)
    lRow = 1
    lCol = lCol + 1
  Next
  Set rSrc = Nothing

End Sub

> A1:E19を1単位として、右隣に同じ形式(2単位目はF1:J19)の情報が
> 100個ほど並んでいます。

100 個というのが意味不明です。

A ~ E 列なら 1 単位辺り 5 列なので、100 単位となると 5 × 100 で
500 列必要になりますね。。Excel2007?

若しくは、5 列 × 20 単位 = 100 列 という意味ですか?

>「$A$1:$E$8,$B$9:$B$19」と入力したら、その情報をコピーして、
> 別シート2のA列1列にそれらの情報をペーストしたいのです。

仮に、「$A$1:$E$8,$B$9:$F$19」が選択された場合はどう...続きを読む

Qファイル名が対象フォルダより長すぎてコピーできない

FAT32の外付けHDDからNTFSの外付けHDDに音楽ファイルを移動したいのですが、ファイル名が対象フォルダにたいして長すぎるためコピーできませんとなります。
クラシック音楽のため、ファイル名に指揮者、会場、交響曲番号、その他表示させたいのでできれば短いファイル名にしたくありません。
FAT32ではできて、NTFSではできないのでしょうか?

下記はコピーできないファイルの一例です。
01. ludwig van beethoven (von karajan - berliner philharmoniker) - symphony no. 5 in c minor, op. 67 1. allegro con brio.flac

Aベストアンサー

ファイル名、フォルダ名、パスにはそれぞれ文字数制限があります。
●ファイル名→最大255文字
●フォルダ名→最大255文字
●パス→最大260文字
ファイル操作(コピー、移動など)ではカレントフォルダ以外ではフルパスが使用されます。
●フルパス→ドライブ名:\フォルダ名\.....\ファイル名
今回の場合コピー元は制限文字数内だがコピー先のパスが制限文字数の260文字を越えたのでしょう。
ファイル名を一旦短い名前に変えコピー後に元に戻すことは可能ですがアプリケーションから利用するときに同様な支障をきたしますのでお勧めしません。
ファイル名を換えたくないのならフォルダ名を換える、フォルダ階層を減らすなど工夫してください。

Qエクセル セル内容の更新時に特定セルをコピー&ペーストする

画像のように、枠線で囲った部分に行単位の選択リストがあります。

ある特定の行のセルが更新されたら(選択しなおされたら)、A22にある時刻を 【その行のO列】に値として転写したいと思います。

例として、C2~N2の一つでも更新されたら、O2に値のみ転写と言う形です。

C3~N3のどれかが変更されたら、O3に転写と言う具合です。

同じように20行目まであります。

具体的にコードで教えて頂ける詳しいかた、教えて頂けませんでしょうか、よろしくお願いいたします。

Aベストアンサー

O列の書式設定は、A22セルと同じにしてくださいね。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRng As Range
Dim r As Range
Set myRng = Intersect(Target, Range("C2:N20"))
If myRng Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In myRng
Cells(r.Row, "O").Value = Range("A22").Value
Next r
Application.EnableEvents = True
End Sub

QDVDのファイルがHDDにコピーできない

OS: OSX10.3
機種:iMac

DVDに保存してあるデータをHDDにコピーすると、コピーの途中で「一部のデータを読み込み、書き込みできないため、操作を完了できません。(エラーコード35)」と表示されてコピーができません。
コピーするファイルは200~250MBのAVIやWMVファイルです。

私なりに調べるとHDDが不足している場合に可能性があるとのことでしたが、空きは35GBと余裕はあります。

どなたかご存知の方、アドバイスのほどどうかお願い致します。

Aベストアンサー

直接ファイルをHDにコピーする方法ではなくアプリケーションというフォルダにあるディスクユーティリティを起動してDVDを仮想DVD化して下さい。

Qエクセルマクロ コピー元と貼り付け先を指定してコピー&ペーストを実行するマクロ

単刀直入にやりたいことを述べます。

Cドライブと仮定します。3つのBOOKがあります。
それぞれ
-----
BOOK1.xls「○○Sheet」・・・(実行するファイル)
  A
1 BOOK2.xls「△△Sheet」・・・(コピーするファイル名の指定です)
2 A2:E2・・・(コピーするセル範囲の指定)
3 BOOK3.xls「□□Sheet」・・・(貼り付け先のファイル名の指定です)
4 A5・・・(貼り付け先のセルの指定)
-----
BOOK2.xls「△△Sheet」・・・(コピー元ファイル)
  ABCDE
1 あいうえお
2 かきくけこ
3 ・・・・・
-----
BOOK3.xls「□□Sheet」・・・(貼り付け先のファイル)
  ABCDE
1 ・・・・・
2 かきくけこ・・・(貼り付け)
3 ・・・・・
-----
>やりたいこと
BOOK1.xls「○○Sheet」のA1のセルの値とA2セルの値を参照し、
その該当BOOKのセル範囲(BOOK2.xls「△△Sheet」のA2:E2)をコピーして、
BOOK1.xls「○○Sheet」のA3のセルの値と、A4セルの値を参照し、
その該当BOOKのセル範囲(BOOK3.xls「□□Sheet」のA5)へペーストする。

別のブックの指定したセルの値を別のブックの指定したセルへ貼り付けるだけなんですが、
以前関数を使って似たような事をしようとしたのですが、うまくいかなかったので、マクロならできるのでしょうか。
よろしくお願いします。(ちなみにエクセル2000又は2003です)

単刀直入にやりたいことを述べます。

Cドライブと仮定します。3つのBOOKがあります。
それぞれ
-----
BOOK1.xls「○○Sheet」・・・(実行するファイル)
  A
1 BOOK2.xls「△△Sheet」・・・(コピーするファイル名の指定です)
2 A2:E2・・・(コピーするセル範囲の指定)
3 BOOK3.xls「□□Sheet」・・・(貼り付け先のファイル名の指定です)
4 A5・・・(貼り付け先のセルの指定)
-----
BOOK2.xls「△△Sheet」・・・(コピー元ファイル)
  ABCDE
1 あいうえお
2 かきくけこ
3 ・...続きを読む

Aベストアンサー

思われていることと違っていたらすみませんが、参考までに下記のコードをBOOK1.xlsのマクロに貼り付けて実行してみてください。
コピー先のBOOKを壊してはいけないので必ず、コピーしたBOOK等でテストしてみてください。
3つのBOOKがCドライブ直下にあり、BOOK1.xlsの参照するシートのシート名が○○Sheetであることが前提です。

メニューバーの「ツール」→「マクロ」→「マクロ」をクリック
 ↓
マクロのダイアログが表示されたらマクロ名に自由に名前を入力してください。(例:コピーペースト)
 ↓
名前を入力しましたら、「作成」をクリック
 ↓
Microsoft Visual Basicの画面が開きますのでSub コピーペースト()の下に次のコードをコピーして貼り付けてください。

Dim INファイル名 As String
Dim INシート名 As String
Dim IN範囲 As String
Dim OUTファイル名 As String
Dim OUTシート名 As String
Dim OUT範囲 As String
Dim 文字列 As String
Dim 検索文字 As String
Dim 文字カウント As Integer
Dim 文字数 As Integer

'○○SheetのA1にあるファイル名とシート名を取得する
文字列 = Sheets("○○Sheet").Range("A1")
検索文字 = "「"
文字カウント = Application.WorksheetFunction.Find(検索文字, 文字列, 1)
文字カウント = 文字カウント - 1 'ファイル名の文字数を取得
INファイル名 = Left(文字列, 文字カウント) 'INファイル名の取得
文字数 = Len(文字列)
文字カウント = 文字数 - (文字カウント + 1) 'シート名の文字数を取得
文字列 = Right(文字列, 文字カウント)
文字カウント = Len(文字列) - 1
INシート名 = Left(文字列, 文字カウント) 'INシート名の取得
IN範囲 = Sheets("○○Sheet").Range("A2") 'コピーの範囲

'○○SheetのA3にあるファイル名とシート名を取得する
文字列 = Sheets("○○Sheet").Range("A3")
検索文字 = "「"
文字カウント = Application.WorksheetFunction.Find(検索文字, 文字列, 1)
文字カウント = 文字カウント - 1 'ファイル名の文字数を取得
OUTファイル名 = Left(文字列, 文字カウント) 'OUTファイル名の取得
文字数 = Len(文字列)
文字カウント = 文字数 - (文字カウント + 1) 'シート名の文字数を取得
文字列 = Right(文字列, 文字カウント)
文字カウント = Len(文字列) - 1
OUTシート名 = Left(文字列, 文字カウント) 'OUTシート名の取得
OUT範囲 = Sheets("○○Sheet").Range("A4") '貼り付ける位置

'A1のセルの値とA2セルの値を参照しコピー
Workbooks.Open Filename:="C:\" & INファイル名 'INファイルのOPEN
Workbooks(INファイル名).Worksheets(INシート名).Activate
Worksheets(INシート名).Range(IN範囲).Select
Selection.Copy 'コピー
Application.DisplayAlerts = False
ActiveWorkbook.Close savechanges:=False 'INファイルのCLOSE
Application.DisplayAlerts = True

'A3のセルの値と、A4セルの値を参照しペースト
Workbooks.Open Filename:="C:\" & OUTファイル名 'OUTファイルのOPEN
Workbooks(OUTファイル名).Worksheets(OUTシート名).Activate
Worksheets(OUTシート名).Range(OUT範囲).Select
Application.DisplayAlerts = False
ActiveSheet.Paste '貼り付け
Application.DisplayAlerts = True
Application.CutCopyMode = False
Application.DisplayAlerts = False
ActiveWorkbook.Close savechanges:=True 'OUTファイルのCLOSE
Application.DisplayAlerts = True

MsgBox "コピー&ペーストが終了しました。  "
'****コピー貼り付けはここまで ****

Microsoft Visual Basicの画面を×で閉じます
 ↓
Excel画面のメニューバーの「ツール」→「マクロ」→「マクロ」をクリック
 ↓
先ほど名前を付けたマクロを選択して「実行」をクリック

BOOK1.xlsの参照するシート名が○○Sheetでない場合は上記のコードの○○Sheetのところを修正してください。
また、各BOOK*.xlsがCドライブ直下に無い場合は、上記コードの"C:\"のところを修正してください。

思われていることと違っていたらすみませんが、参考までに下記のコードをBOOK1.xlsのマクロに貼り付けて実行してみてください。
コピー先のBOOKを壊してはいけないので必ず、コピーしたBOOK等でテストしてみてください。
3つのBOOKがCドライブ直下にあり、BOOK1.xlsの参照するシートのシート名が○○Sheetであることが前提です。

メニューバーの「ツール」→「マクロ」→「マクロ」をクリック
 ↓
マクロのダイアログが表示されたらマクロ名に自由に名前を入力してください。(例:コピーペースト)
 ↓
名...続きを読む

Qファイルコピーが上手くできないのは?

ごく最近、OSをXPからWindows 7 (Home Premium,32 bit)に変更しました。データを外付けHDDにコピーバックアップして、新OSをインストールした後、データをコピーして戻しました。表面上はコピーができましたが、上手くコピーできているファイル、ファイルだけコピーされファイルの中は白紙のようなファイルもあります。このような現象は、Windows 7ではよく見られることなのでしょうか?またこのような現象が起こる原因として、どのようなことが考えられるのでしょうか?ご教示、よろしくお願いいたします。

Aベストアンサー

次のことを明確に書かないと判断できません。
(1)XPで外付けHDDにコピーした時点ではファイルの内容も問題なくコピーできていたのですか。
コピー使用したツールは?。(コマンドやパラメータは?)
コピー元とコピー先のコピーバイト数も含めて同じであることをコピー完了後に確認したのですか。
(2)Win7で外付けHDDからコピーして戻したときのツールは?。(コマンドやパラメータは?)

> このような現象は、Windows 7ではよく見られることなのでしょうか?
原因はコピー操作ミス以外は考えられません。
コピー元のフォルダやファイルの属性やセキュリティ状態を配慮していないことも操作ミスに該当するものとします。
---
たとえば ドライブd の ファイルを全て ドライブf のフォルダmyfolderに丸ごとコピー(システム、隠し、読み取り専用も含めて)する場合は次のようになります。
戻す場合も同じ要領です。(ただしWin7の場合はxcopyだけではなくてrobocopyコマンドが使用できる)
xcopy d:\*.* f:\myfolder /s /h /r /y

次のことを明確に書かないと判断できません。
(1)XPで外付けHDDにコピーした時点ではファイルの内容も問題なくコピーできていたのですか。
コピー使用したツールは?。(コマンドやパラメータは?)
コピー元とコピー先のコピーバイト数も含めて同じであることをコピー完了後に確認したのですか。
(2)Win7で外付けHDDからコピーして戻したときのツールは?。(コマンドやパラメータは?)

> このような現象は、Windows 7ではよく見られることなのでしょうか?
原因はコピー操作ミス以外は考えられません。
コピー...続きを読む

QVBAでの結合セルのコピー&ペースト

こんにちは。
EXCELのVBAでマクロを作成しています。
セルの値のコピー&ペーストを行おうとしているのですが、結合されているセルのペーストのときに、「同じ結合セルが必要です」とエラーになってしまいます。
例えば、A1とA2が結合されたセル+A3をコピー
Worksheets(x).Activate

Range("A1:A3").Selection
Range("A1:A3").Copy

別のシートで、B1とB2が結合されたセル+B3にペースト
Worksheets(y).Activate
Range("B1:B3").Paste


セルの結合を解除すればうまくいきます・・・
セルを結合したままペーストしたいのですが、どうやら間違っているようです(ノ_・。)
どなたか教えてください。
よろしくお願いします。

Aベストアンサー

nao_linさんこんにちは。merlionXXです。

> 値だけ貼付けのオプションをつけるとエラーになってしまうのは何故なのでしょうか?

結合セルの値貼り付けは無理のようですね。↓
http://support.microsoft.com/default.aspx?LN=JA&scid=kb;ja;JP416846

Q削除もコピーもできないファイル

削除もコピーもできないファイル

フォルダーの中のファイルを削除して、フォルダを閉じてからフォルダを開くと削除されずに復活して
います。削除はShift+Delでやっていますが、エラーメッセージは全く表示されません。
何度やっても元に戻ります。

ちなみに、そのファイルをコピーしてペーストすると次のようなエラーメッセージが表示されます。

「xxxxをコピーできません。ファイル又はディレクトリが壊れているため、読み取ることができません。」

エクスプローラーで見るとファイルサイズは0になっています。(ファイルは.jpgです。)

PCのデータをバックアップしようとすると、このファイルの処で中断してしまい、困っています。
どなたか完全に削除できる方法を教えて下さい。

Aベストアンサー

多分、ディレクトリが壊れていると思います。

バックアップを取ってから処理をする方が良いのですが、ファイル単位のバックアップはコピーができませんから無理かと。

ディスク全体をバックアップするイメージバックアップのソフトを使う必要があると思います。


チェックディスクを実行すれば通常は直ると思います。

XPの場合は「スタート」から「ファイルを指定して実行」だったと思いますが

chkdsk C: /f
(ディスク容量により時間がかかります)

あるいは

chkdsk C: /r
(/fよりさらに時間がかかります)

「C:」は消せないファイルがあるドライブを指定してください。

どんなに時間がかかっても実行が終了するまで待ってください。

途中で強制終了したり電源を切ったりするとどうなるかわかりません。

Qサイズの異なる結合セル間でのコピー&ペースト

いつもお世話になっております。

Excel 2007
Windows XP Proffessional

サイズの異なる結合セル間において、
一括して多数のコピー&ペーストをしたい場合、
何か良い方法はありますでしょうか。
(ただし、それぞれの結合セルのサイズ等は一切変更できません)

どうぞアドバイスのほどよろしくお願いします。

Aベストアンサー

下記で合っているでしょうか?
違っていたらその旨教えてください。
「コピー元左上セル」と「貼付け開始左上セル」のシート名、セル番地は実際に合わせてください。

Sub test横横複数行()
  Dim acell As Range
  Dim bcell As Range
  Dim i As Long
  Dim cn As Long

  Set acell = Sheets("Sheet1").Range("A1") 'コピー元左上セル
  Set bcell = Sheets("Sheet1").Range("A5") '貼付け開始左上セル
  Do While acell.Offset(0, i).MergeCells
    cn = cn + acell.Offset(0, i).Columns.Count
    i = i + 1
  Loop
  
  Do While bcell.MergeCells
    bcell.Resize(1, cn + 1).Value = acell.Resize(1, cn + 1).Value
    Set bcell = bcell.Offset(1, 0)
  Loop

  Set acell = Nothing
  Set bcell = Nothing
End Sub

下記で合っているでしょうか?
違っていたらその旨教えてください。
「コピー元左上セル」と「貼付け開始左上セル」のシート名、セル番地は実際に合わせてください。

Sub test横横複数行()
  Dim acell As Range
  Dim bcell As Range
  Dim i As Long
  Dim cn As Long

  Set acell = Sheets("Sheet1").Range("A1") 'コピー元左上セル
  Set bcell = Sheets("Sheet1").Range("A5") '貼付け開始左上セル
  Do While acell.Offset(0, i).MergeCells
    cn = cn + acell.Offset...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング