エクセルvba 一つ上の行を指定した回数分コピーする。

教えて下さい。vba初心者です。

A B C D E F G H
7 522 加藤 沖縄 みかん 縄 1 1/5 空欄
8 123 吉田 愛媛 りんご 水 3 2/10 空欄

1️⃣一番最後に入力した行をすぐ下にコピーしたい。（ここでは7行目…入力して行くと行は増えます。）
2️⃣指定回数はE列。

この列ではE列が3回になりますので、
コピーしたい範囲はA〜G列を、すぐ下の8行〜9行までの2回分コピーしたいです。

完成希望例
A B C D E F G H
7 522 加藤 沖縄 みかん 縄 1 1/5 空欄
8 123 吉田 愛媛 りんご 水 3 2/10 空欄
9 123 吉田 愛媛 りんご 水 3 2/10 空欄
10 123 吉田 愛媛 りんご 水 3 2/10 空欄

にしたいです。

質問者からの補足コメント

• 2️⃣の訂正です。
  指定回数はF列です。
  
  1番上のABCはエクセルの列番号
  左端の7と8はエクセルの行番号です。
  初めて質問した為、見にくくなってしまい、すみません。

    補足日時：2017/03/13 01:57

• 11行目からも同様に異なる新たなデータを入力後、
  Ｆ列の回数分コピーしたいです。
  
  データをどんどん追加して行きたいのです。

    補足日時：2017/03/13 23:25

• 画像を補足させて頂きました。
  ご指導お願いします。

  
    補足日時：2017/03/14 00:06

• yokomaya様
  画像です。

  
    補足日時：2017/03/15 00:24

• ymkomayaさま

  
    補足日時：2017/03/15 00:25

• ymkomayaさま

  
    補足日時：2017/03/15 00:26

• ymkomayaさま
  こちらがエラーの画像です。

  
    補足日時：2017/03/15 00:28

• ymkomayaさま
  
  先程のR列の画像です。
  17列〜21列にしたいです。
  ご不便お掛けしますが、ご教授お願いします。

  
    補足日時：2017/03/15 23:02

• 出来ました！うれしいです(喜）
  添付方法を勉強しておりました。
  今回教えていただいたプログラムをコピーして、貼り付けてみました。
  TABキーでインデントを何度か入れたりしながら、作動するように頑張ってるのですが、なかなか赤文字エラーが取れないです。
  どこでＴＡＢを入れたらよいのか教えていただけますでしょうか？
  
  あと２回で補足ができなくなってしまうと…yokomayaさまに繋がらなくなってしまうのが不安です。
  こちらの他にあと２つお聞きしたい事が残っていまして…
  ①管理表のＡ１部分に検索をかけたいです。Ａ７以降に入力した番号をＡ１に入力すると（例　Ａ１に123と入力後、Ａ７に登録した123と合致するデータを全て呼び出したいです。
  ②前回教授頂いた条件検索の横に番号Ａ列とＦ列の２個の条件に一致するデータを取り出す関数も教えてください。（管理表Ｆ列でコピー回数指定の後、上書き直してます。）

  
  No.18の回答に寄せられた補足コメントです。 補足日時：2017/03/16 15:49

• 最後の補足になってしまいました。
  今まで本当にお世話になり、感謝申し上げます。
  これからもよろしくお願いします<m(__)m>

  
    補足日時：2017/03/16 21:43

No.14 回答者： yokomaya 回答日時： 2017/03/14 22:22

うう、名前定義ですぅ。

数式リボンに名前定義がありませんか？
そこの話です。
OFFSETはそちらに使わないと機能しません。

VLOOKUPの記述はこんな感じ。
=VLOOKUP(I16,管理表領域,2)

管理表領域は別にどんな名前でもいいです。
ただ管理表だけだとシート名と混乱するかと思って。

別件ですが、添付画像はWindowsアクセサリーのSnippingToolを
使ってます。カメラより見やすく任意領域が切り取り出来ますよ。

この回答へのお礼

夜分に恐れ入ります。
名前の領域設定出来ました。
ありがとうございます。
不具合があり、質問したいです。
場合によって、正確に認識出来る場合と、一部エラーの場合、全てエラーになる場合があります。
どこか間違えているのでしょうか？

Windowsアクセサリーがわからず、ツールが使えませんでした。
アクセサリーの勉強もしたかったのですが、時間がかかるので、今回は画像で対応させて下さい（泣）
補足質問コーナーに画像添付します。
すみません。
ご教授お願いします。

お礼日時：2017/03/15 00:22

No.13 回答者： yokomaya 回答日時： 2017/03/14 19:59

＞シート2にVLOOKUP関数が入っていて、管理表（sheet1）のＡ列のコード番号を入力すると、内容が表示されるシートを作ってあったのですが、

＞Ａ行のコード番号を入力しても#N/Aになってしまいました。
＞別シートでVLOOKUP関数が使えるようにするためにはどうしたらよいのでしょうか？

VLOOKUPの式を見ずに答えるのはちょいムズイんですが
VLOOKUPは探す値と範囲がありますよね。
この範囲が管理表では拡大していくということですよね。
ということは、範囲が可変じゃないといけないわけです。
で、そういった場合には通常名前定義を用います。
名前定義、可変領域でググってみて戴けませんか。
やってみて不明ならまた尋ねてください。

この回答へのお礼

何度も恐れ入ります。
ご教授お願いします。
offset関数とvloolup関数を使って何度も試しましたが、うまくいきませんでした。
sheet2のI16のセルに123と入力した時、
sheet2のB9のセルに吉田と表示させたいです。
これで試しましたが、エラーでした。
=VLOOKUP(I16,OFFSET(管理表!A7,0,0,COUNTA(A:A)-1,18),2)

元データとして・・・sheet1はA7からデータは始まります。
sheet1のA8に123
sheet1のB8に吉田
になっています。

offsetの使い方が理解できなかったです（涙）
ご教授お願いします。

お礼日時：2017/03/14 21:35

No.12 回答者： yokomaya 回答日時： 2017/03/14 19:16

抜けてると思ったけど大丈夫だった。

勘違いすみません。
１で割っても余りは出ない・・・。(-_-;)

この回答へのお礼

yokomayaさま
補足回数が残り１回になってしまいました;つД｀)
空いているお礼ボックスがあったのでそちらから失礼します。
どうか残り２つ…教えていただきたいことがあります。
①sheet1の管理表のＡ１の列にA7以降に入力済の番号の内の一つを選んで（例123と番号入力したら、Ａ７以降に入力した123に該当する番号のデータのみを全て表示させたいのです。
②sheet2のvlookupの検索地の横にもう一つ検索地を設けて、２つのデータに一致する行を表示させたいのです。
sheet1の情報はＡ７以降とＦ７以降のデータです。Ｆ７は以前ご教授頂いた指定の数こコピーの指令個所です。（コピー後、手入力で任意番号を上書きしています。）sheet2で　=VLOOKUP(K17&L171,回数,15,FALSE)　★名前の定義は設定済です。これでは2種類条件の一致するデータは拾えませんでした。（ｋ17はsheet1で指定したa列の番号とⅬ17はsheet1のＦ列の任意番号です。）

本当は補足で画像を添付して送りたいのですが…大切な残り1回を残しておきたいのです。
今後もyokomayaさまにご教授お願いしたいのですが、どうしたらよいのでしょうか？

お礼日時：2017/03/16 19:52

No.11 回答者： tom04 回答日時： 2017/03/14 19:14

何度もごめんなさい。

単に最終行だけの操作であればもっと簡単にすればよかったです。

コマンドボタンのコードを↓にしてください。

Private Sub CommandButton1_Click()
Dim lastRow As Long, lastCol As Long, cnt As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 6 Then
lastCol = Cells(6, Columns.Count).End(xlToLeft).Column
If Cells(lastRow, "F") > 1 Then
Do Until cnt = Cells(lastRow, "F") - 1
cnt = cnt + 1
Cells(lastRow, "A").Resize(, lastCol).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
Loop
End If
End If
End Sub

どうも失礼しました。m(_ _)m

No.10 回答者： tom04 回答日時： 2017/03/14 18:12

No.3・4・6です。

＞入力後（行のコピー起動ボタンを作りました。）

コマンドボタンを挿入したというコトでしょうか？
その場合は

Private Sub CommandButton1_Click()
と
End Sub
の中に旋回のコード（Sub Sample・・・と　End Sub以外）をコピー＆ペーストしてみてください。

７行目からデータがある場合はコード内の「8」を「7」に変更してください。

※　まず、最初のデータだけの状態からマクロを実行（コマンドボタンをクリック）してみてください。
あとはデータ追加後、随時ボタンをクリック！m(_ _)m

No.9 回答者： yokomaya 回答日時： 2017/03/14 18:05

ごめんなさい。

1の場合処理不要がぬけてます。わかります？今外なので。

この回答へのお礼

何度もご丁寧にありがとうございます。
恐れ入りますが、補足でもう一件お願いします。

おかげさまで管理表は無事出来たのですが、別シート（sheet2）に伝票があります。
シート2にVLOOKUP関数が入っていて、管理表（sheet1）のＡ列のコード番号を入力すると、内容が表示されるシートを作ってあったのですが、
Ａ行のコード番号を入力しても#N/Aになってしまいました。
別シートでVLOOKUP関数が使えるようにするためにはどうしたらよいのでしょうか？

お礼日時：2017/03/14 19:46

No.8 回答者： yokomaya 回答日時： 2017/03/14 17:25

ＶＢＡの方じゃなくてＥＸＣＥＬの

そのシート名を右クリックで出ませんか？

この回答へのお礼

出来ました(泣)
ありがとうございました。
これで仕事がはかどりそうです。

お礼日時：2017/03/14 17:58

No.7 回答者： yokomaya 回答日時： 2017/03/14 08:58

こちらこそ文をよく読まずに失礼いたしました。

下記はG列まで行入力完了時、自動的に発動します。
シート名右クリックコードを表示で出る
シートモジュールに貼ってください。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range, i As Long
If Target.Column = 7 Then 'G列変更時に
Set cl = Range("F20000").End(xlUp)
i = 1
Do While cl = cl.Offset(-i, 0)
i = i + 1
Loop
If i Mod cl.Value = 1 Then 'G列の修正だけなら処理しない
Application.EnableEvents = False 'イヴェント発生停止
cl.EntireRow.Copy Cells(cl.Row + 1, 1).Resize(cl.Value - 1, 1)
Application.EnableEvents = True
End If

End If
End Sub

この回答へのお礼

自動発動出来れば、かなり嬉しいです。
ありがとうございました。
頂いたコードをそのまま貼り付けましたが、自動で発動しないのです。
【シート名右クリックコードを表示で出る。シートモジュールに貼ってください】
の事でしょうか？
理解力不足で申し訳ないのですが、どこに貼れば良いのかわからないので、ご指導お願いします。
今回のシート名は 管理表．xlsm-module2（コード）と言う名前で画面表示があります。
ご教授お願いします。

お礼日時：2017/03/14 17:22

No.6 回答者： tom04 回答日時： 2017/03/14 08:56

続けてお邪魔します。

当然のコトですが同じマクロを何度も繰り返して実行すると
いくらでも行は追加されてしまいます。

①　COUNTIF関数などで重複がない行だけ操作をする。
②　どこか使っていない列を使い一度操作した行はフラグを立て、それを目印にフラグがない行だけ操作を実行する。

といった方法で対処するのが良いと思います。
簡単なのは①だとおもいますが、②のコードにしてみました。

Sub Sample2()
Dim i As Long, cnt As Long, lastCol As Long
lastCol = Cells(6, Columns.Count).End(xlToLeft).Column
For i = Cells(Rows.Count, "A").End(xlUp).Row To 8 Step -1 '//←前回は7行目まで？
If Cells(i, "F") > 1 Then
If Cells(i, lastCol + 1) = "" Then
Cells(i, lastCol + 1) = 1
Do Until cnt = Cells(i, "F") - 1
cnt = cnt + 1
Rows(i + 1).Insert
Cells(i, "A").Resize(, lastCol + 1).Copy Cells(i + 1, "A")
Loop
cnt = 0
End If
End If
Next i
Cells(1, lastCol + 1).EntireColumn.Hidden = True
End Sub

前回は7行目以降の操作にしていたのですが、8行目以降の操作になるのでしょうか？m(_ _)m

この回答へのお礼

ご教授ありがとうございます。
試してみましたが･･･作動しませんでした。（←前回は～？までは消しました。）私の知識不足でお手数おかけします。

説明の補足をさせてください。
①7行目のデータをＦ列指定の回数だけコピー後、（例3回指定であれば、7行目に入力した分を含め9行目まで同一のデータに貼り付け。

②10行目以降も異なる新規データを登録する為、入力後（行のコピー起動
ボタンを作りました。）起動ボタンを押した時に、新らたに入力した１行のみをＦ列の指定の回数分コピーする操作は可能でしょうか？

お礼日時：2017/03/14 17:52

No.5 回答者： tom04 回答日時： 2017/03/13 23:54

No.3・4です。

＞Do Until cnt ＝ cells(i,”e”) - 1
＞の部分が黄色く光っていて、実行出来ないのです。

ん？E列に回数の数値が入っているのでは？
E列が文字列だとエラーになります。

あっ！補足の文章が目に入りました。
質問文では「E列」が回数だと書いてあると思うのですが、
補足では「F列」になっていますね。F列に回数があるのであれば・・・

前回のコードの　"E"　の部分をF列の　"F"　に変更してください。
（2か所あります）m(_ _)m

この回答へのお礼

ありがとうございます。
Ｆにしたらコピー出来ました。

引き続きご指導お願いします。
11行目にまた異なる新たなデータを入力してvba実行したら…
8行目からのデータがズラリとコピーされてしまいました。

今後も異なる新たなデータを増やして行く予定で、一行上の入力した分のデータのみＦの回数分コピーして行きたいです。

ご指導お願いします。

お礼日時：2017/03/14 00:23