コピー用に、関数入りの行を一番下(65535行)にとってあります。
これについて。。。
関数入りの行を挿入したいときは?の質問に、
下記のようなマクロを作成してくださった方がいらっしゃるのですが、
間に挿入されるのではなく、上書きされて、前のデータが消えてしまいます。
例えば、3行目と4行目の間…5行目と6行目の間…として、
挿入で使いたいときは、
どこをどのように直したら良いか、教えてください。
空白行がたくさんあって、その行は詰めていただいて良いです。
うーん…もしかして…意味不明ですか?


'一番下の行コピー
Rows(65535).Copy

'現在のカーソル位置の一番左のA列へ移動
Cells(ActiveCell.Row, 1).Select

'そこに貼り付け
ActiveSheet.Paste

'コピーモード解除
Application.CutCopyMode = False

A 回答 (1件)

貼り付けと挿入のソース上の違いは


貼り付けが Paste なのに対して
挿入は Insert なだけです。

下を読んで解らない時はもう一度聞いてください。

最終行に値が有る状態で行の挿入を行うとエラーが出てしまいます。
そこで、挿入の前に一行削除する必要があります。

例1)挿入する行を選択している事が前提です。
sub 例1()
Dim del_row As Long
'↓削除できる行の検索(A列を必須入力列としています。)
del_row = Range("A65536").End(xlUp).Row + 1
'↓不要行の削除(Shift:=xlupは削除後上に詰めるを意味します。)
Rows(del_row).Delete Shift:=xlUp
'↓最終行のコピー
Rows(65535).Copy
'↓コピー内容の挿入(挿入する列が選択されている事が前提です)
Selection.Insert Shift:=xlDown
'↓コピーモードの終了
Application.CutCopyMode = False
end sub

例2)例1と似ていますが、選択行の下に挿入します。
Sub 例1()
Dim del_row As Long
del_row = Range("A65536").End(xlUp).Row + 1
Rows(del_row).Delete Shift:=xlUp
Rows(65535).Copy
'↓コピー内容の挿入(Offset(1,0)で選択行の1行下に設定)
Selection.Offset(1, 0).Insert Shift:=xlDown
Application.CutCopyMode = False
End Sub
    • good
    • 0
この回答へのお礼

例1の方が、イメージにピッタリでした。
うまく動いてくれて、感激。
ご丁寧なコメントも助かりました。
ありがとうございました。
また機会がありましたらお世話してください。

お礼日時:2001/08/05 16:13

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

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

QVBAで、行のcopy,Paste

環境:WindowsXPSP3 Office2010です。

ヤリタイ事その1
(1)BookAのSeet4以降にSheet(1行目のセルには項目が入っています、列数はみな同じです。行数は違います)を追加していきたい。
(2)使っていないSheet1,2,3はスキップする。一行目には、何年何組、男女の区別、生徒氏名、生徒証番号、1学期の中間試験の国語の成績、1学期の期末試験の国語の成績、担当教員名、2学期の中間試験の算数の成績、担当教員名、・・・・・・
(3)追加したSheetnの最後のSheetnにもう一つSheetn+1を追加したい。
(4)Seet4からSheetnまでの各SheetのセルをSheetn+1に「下向けに」貼り付けていきたい。
(5)何年何組が40あったら、まづ、40行、次に何年何組が20あったら、次の20行、・・・・
前回ご指導頂いた方法で試しました。ちょっと変更しましたが、その時は、ほぼ旨くいきました。
Worksheets.Add Before:=Worksheets(1)
Dim sheetsuu As Integer 'sheetsuuはシートの数です。
Dim kk As Integer
Dim m As Integer
sheetsuu = ActiveWorkbook.Worksheets.count
For kk = 4 To sheetsuu - 1 Step 1
Worksheets(kk - 3).AutoFilter.Range.Offset(1).Copy Range("A65536").End(xlUp).Offset(1)
Next kk
しかし、Sheetn+1にSheet4の1行目をPasteしようしましが、旨くいきません。
要するに項目がcopy,Pasteとしようとしましたが、旨くいきません。
手打ちでは、出来ます。Sheet4の一行目Ctrl+C シートの最後まで行き、Ctrl+Vで出来ます。
しかし、マクロを使うと出来ません。どなたか、ご指導して頂けませんでしょうか?
何卒宜しくお願い申し上げます。

ヤリタイ事その2
(1)上記【ヤリタイ事その1】が、出来たら、Sheetn+1を別のBook1.xlsxに
copy,Pasteとしようとしましたが、旨くいきません。
これも色々検索しました。
試した数、デバック文を入れた物沢山ありますが、旨くいきそうな例を下記にしまします。
下記も旨くいかない例です。
Dim nWbk As Workbook
Set nWbk = Workbooks.Add
ThisWorkbook.Worksheets("Sheet &kk").Copy Before:=Worksheets("Sheet1")
どなたか、ご指導して頂けませんでしょうか?
何卒宜しくお願い申し上げます。

環境:WindowsXPSP3 Office2010です。

ヤリタイ事その1
(1)BookAのSeet4以降にSheet(1行目のセルには項目が入っています、列数はみな同じです。行数は違います)を追加していきたい。
(2)使っていないSheet1,2,3はスキップする。一行目には、何年何組、男女の区別、生徒氏名、生徒証番号、1学期の中間試験の国語の成績、1学期の期末試験の国語の成績、担当教員名、2学期の中間試験の算数の成績、担当教員名、・・・・・・
(3)追加したSheetnの最後のSheetnにもう一つSheetn+1を追加したい。
(4)Seet4からSheetnま...続きを読む

Aベストアンサー

なんだかイマイチわからないけど(・_・;

その2は、ANo.1の指摘どおりですね。名前は不定なのでsheets(1)で。
その1は・・・

◆ こういうことかな?
'--> ループの3行を差し替え
Worksheets(2).Rows(1).Copy Rows(1) 'タイトル行コピー
For kk = 2 To sheetsuu - 3 Step 1
 Worksheets(kk).AutoFilter.Range.Offset(1).Copy Range("A65536").End(xlUp).Offset(1)
Next kk
'<--
※Rowsは行。わかりにくければコッチで↓
Worksheets(2).Range("A1:Z1").Copy Range("A1:Z1")

◆以下、説明
回答に頼ると、理解がおいつかず混乱しがち。
ちゃんと処理を理解してね!!

◇ コピー対象がおかしい?
> For kk = 4 To sheetsuu - 1 Step 1
> Worksheets(kk - 3)...
-3 してるので結局、sheets(1 to sheetsuu - 4)になってます。シートindexは左から1,2,3・・・。直前で左端(1)に追加しているので、コピー対象は 2 ~ sheetsuu-3 では?
たぶんsheets(1)にはAutoFilterがないので、オブジェクトがない!ってエラーになるかと。

◇ タイトル行をコピーする処理
が無いのは分かってる・・・?念のため説明
 .AutoFilter:オートフィルターの
 .Range  :セル範囲を
 .Offset(1):下方に1ずらした範囲
をコピーしてます。
タイトル行を含まないようズラしているので、コレはOK。あとは、ループ前(か後)にタイトル行のみをコピーするだけ。

◇ デバッグ
コピーなんてセルを正しく指定するだけなので、セル選択でもすれば1発で確認できます。
for kk = 1 to sheets.count
 sheets(kk).Select
 sheets(kk).AutoFilter.Range.Select
 Stop '一時停止(F5/F8で継続)
 Selection.Offset(1).Select
 Stop '一時停止(F5/F8で継続)
next
こういうの大事。1つずつ確認。理解も深まります。

また、ブレイクポイント、ステップ実行、ローカルウィンドウなど、便利なデバッグ機能も多いです。ぜひ使えるようになってください。

なんだかイマイチわからないけど(・_・;

その2は、ANo.1の指摘どおりですね。名前は不定なのでsheets(1)で。
その1は・・・

◆ こういうことかな?
'--> ループの3行を差し替え
Worksheets(2).Rows(1).Copy Rows(1) 'タイトル行コピー
For kk = 2 To sheetsuu - 3 Step 1
 Worksheets(kk).AutoFilter.Range.Offset(1).Copy Range("A65536").End(xlUp).Offset(1)
Next kk
'<--
※Rowsは行。わかりにくければコッチで↓
Worksheets(2).Range("A1:Z1").Copy Range("A1:Z1")

◆以下、説明
回答に頼ると、理解がお...続きを読む

Q関数入りの行を挿入したいです。

エクセルの一番下の行に、関数入りのコピー用の行を1行残し、あとはデータになっています。
一番下の行をコピーし、その行を挿入したいときは、どのようにマクロを組んだら良いでしょうか。
かなり初心者なので、できましたら、具体的に記述して教えてください…

Aベストアンサー

どもども 田吾作7です。

サンプルです。
機能としては、一番下の行を、現在アクティブなセルを持つ行へコピーします。

'一番下の行コピー
Rows(65535).Copy

'現在のカーソル位置の一番左のA列へ移動
Cells(ActiveCell.Row, 1).Select

'そこに貼り付け
ActiveSheet.Paste

'コピーモード解除
Application.CutCopyMode = False

でわでわ

QVBAで行コピーして挿入

1行目の内容をコピーして、他の場所に指定数分だけ
挿入するマクロを作りました。

そのマクロ自体は、正しく動いたのですが、コピー元の1行目に
他のシートを参照する関数が入っていた場合、想定どおりの
結果を得ることができません。

[SHEET1:データのみを記載]
省略

[SHEET2]
A1セル:   =SHEET1!$A1 ←コピー元の行

[マクロ:一部抜粋]
myR = Application.InputBox("挿入する行数を入れてください", , "1")

For i = 1 To myR
  Rows("1:1").Copy
  Cells(ActiveCell.Row, 1).Select
  Selection.Insert Shift:=xlDown
  Selection.EntireRow.Hidden = False
Next i

どういう結果を求めたいかというと、たとえば、
SHEET2のA10セル上で、このマクロを実行し、 "挿入行 = 3" と指定したら

A10:   =SHEET1!$A10
A11:   =SHEET1!$A11
A12:   =SHEET1!$A12

となってほしかったのですが、結果は、

A10:   =SHEET1!$A10
A11:   =SHEET1!$A10
A12:   =SHEET1!$A10

となってしまいました。

どうにか、求める結果を得られるようにできないでしょうか?

1行目の内容をコピーして、他の場所に指定数分だけ
挿入するマクロを作りました。

そのマクロ自体は、正しく動いたのですが、コピー元の1行目に
他のシートを参照する関数が入っていた場合、想定どおりの
結果を得ることができません。

[SHEET1:データのみを記載]
省略

[SHEET2]
A1セル:   =SHEET1!$A1 ←コピー元の行

[マクロ:一部抜粋]
myR = Application.InputBox("挿入する行数を入れてください", , "1")

For i = 1 To myR
  Rows("1:1").Copy
  Cells(ActiveCell.Row, 1).S...続きを読む

Aベストアンサー

Active.Cellが同一の位置なのだから相対変位しません。

一例です。(ループは不要なので削除しました)
myR = Application.InputBox("挿入する行数を入れてください", , "1")
Rows("1:1").Copy
Rows(ActiveCell.Row & ":" & ActiveCell.Row + myR - 1).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False

QVB2010でExcelの行をコピーして挿入する

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

VB2010を使用してExcelのある1行をコピーして、コピーしたものを同じシートに挿入したいのですが方法がわかりません。

画像のように、35と36の行をコピーして、37と38に全く同じ物を挿入したいです。


サイトをしらみつぶしに探しましたが、私に理解できるサイトがヒットしませんでしたので、できればサンプルコードを教えていただけると嬉しいです。

下記のようにコードを書きましたが、コピペ状態でほとんど理解していません。

Imports Microsoft.Office.Interop
Public Class Form1
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Shown
Me.Visible = False
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

'Excelブックを起動
xlBook = xlApp.Workbooks.Open("C:\test1.xls")
'Excelを表示
xlApp.Visible = False
'シートを指定
xlSheet = DirectCast(xlBook.Worksheets(1), Excel.Worksheet)
xlSheet.Activate()

'ここから
'
'
'
'
'ここまでがわかりません

' xlBook.Save() '上書き保存
xlBook.SaveAs("c:\test2.xls") '名前をつけて保存

xlBook.Close()
xlApp.Quit()
'終了処理

xlSheet = Nothing
xlBook = Nothing
xlApp = Nothing
'テストが完了したらループ処理に変更する
Dim p() As Process = Process.GetProcessesByName("Excel")
p(0).Kill()
End Sub
End Class


エクセルのバージョンはExcel 2003です。

お手数おかけしますがよろしくお願いします。

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

VB2010を使用してExcelのある1行をコピーして、コピーしたものを同じシートに挿入したいのですが方法がわかりません。

画像のように、35と36の行をコピーして、37と38に全く同じ物を挿入したいです。


サイトをしらみつぶしに探しましたが、私に理解できるサイトがヒットしませんでしたので、できればサンプルコードを教えていただけると嬉しいです。

下記のようにコードを書きましたが、コピペ状態でほとんど理解していません。

Imports Microsoft.Office.Interop
Public Class F...続きを読む

Aベストアンサー

エクセル開放とエクセルを起動のSetの部分は、
.Netでは外してOKです。

解決できて良かったです(^o^)

答えが同じでも、いろいろなやり方がありますので、

これからいろいろチャレンジしてみて下さい。

Q行挿入+貼付けと空白行削除を同時に行うには?

行挿入+貼付けと空白行削除を同時に行うには?

VBA初心者です。
仕事でエクセルを使っていますが、


no  工程1 工程2 工程3
1   A   B   C
2   B   _   A
3   C   A   _
4   _   C   A


という表を
no  工程
1   A
    B
    C
2   B
    A
3   C
    A
4   C

というように並び替えたいのですが、
現在は各番号ごとに3行挿入して工程をコピー、行と列を入れ替えて貼付けをしています。
これだと
no  工程
1   A
    B
    C
2   B 

    A
3   C
    A

4
    C
    A
のように空白行ができてしまいます。これをもう一度、マクロで消しているのですが、
データ量が多いため、行挿入と空白行を消す作業を同時に行わないとシート最大行数である
65536行を超えてしまう可能性があります。
同時にやるにはどのようにすればよいのでしょうか?
よろしくおねがいします。

Aベストアンサー

参考にしてください。

配列に入れて一度に書き出します。
サンプルでは、F列G列へ

Sub test()
Dim varArray(1 To 65536, 1 To 2)
varArray(1, 1) = "no"
varArray(1, 2) = "工程"

Dim i As Long, r As Long, c As Long

i = 2
For r = 2 To Range("A65536").End(xlUp).Row
varArray(i, 1) = Cells(r, 1)
For c = 2 To 4
If Cells(r, c) <> "" Then
varArray(i, 2) = Cells(r, c)
i = i + 1
End If
Next c
Next r
Range("F1:G65536") = varArray
End Sub

参考にしてください。

配列に入れて一度に書き出します。
サンプルでは、F列G列へ

Sub test()
Dim varArray(1 To 65536, 1 To 2)
varArray(1, 1) = "no"
varArray(1, 2) = "工程"

Dim i As Long, r As Long, c As Long

i = 2
For r = 2 To Range("A65536").End(xlUp).Row
varArray(i, 1) = Cells(r, 1)
For c = 2 To 4
If Cells(r, c) <> "" Then
varArray(i, 2) = Cells(r, c)
i = i + 1
...続きを読む


人気Q&Aランキング

おすすめ情報