こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

回答受付中の質問

Excel2007で質問です。

sheet1にセルD3から下に向かってデータが2000個以上入ってます。

(1)マクロボタンを押します。

(2)D列で任意の行番号の値(今回は1000行目)をコピーします。

(3)sheet2,sheet3,sheet4のN6に(2)をペイストします。

(4)、(1)に戻りマクロボタンを押します。

(5)、(2)に行きまして、1つ下の1001行目をコピーします。

(6)、(3)に行きN6の下のN7にペイストします。

これをマクロボタンを押す度に繰り返したいです。

投稿日時 - 2019-02-05 21:47:29

QNo.9585007

困ってます

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(5)

ANo.5

>マクロボタンが押される度にN6から最下セルにデータを転記処理出来
Sub 転記処理3()
  Dim i As Long, LastRow As Long
  With Sheets("Sheet1")
    LastRow = Sheets("Sheet2").Cells(Rows.Count, "N").End(xlUp).Row + 1
    If LastRow < 6 Then LastRow = 6
    i = .Range("B1").Value
    .Cells(i, "D").Copy Sheets("Sheet2").Cells(LastRow, "N")
    .Cells(i, "D").Copy Sheets("Sheet3").Cells(LastRow, "N")
    .Cells(i, "D").Copy Sheets("Sheet4").Cells(LastRow, "N")
    .Range("B1").Value = .Range("B1").Value + 1
  End With
End Sub

投稿日時 - 2019-02-06 10:37:21

お礼

できました!!ありがとうございます。またご協力ください。

投稿日時 - 2019-02-06 18:04:45

ANo.4

>B1に予め1000を入れました。これを利用した場合のソース
では転記先の各シートのN列の行数の記録は、どうされますか
とりあずSheet1のC1セルとしました。
Sub 転記処理2()
  Dim i As Long, j As Long
  With Sheets("Sheet1")
    i = .Range("B1").Value
    j = .Range("C1").Value
    .Cells(i, "D").Copy Sheets("Sheet2").Cells(j, "N")
    .Cells(i, "D").Copy Sheets("Sheet3").Cells(j, "N")
    .Cells(i, "D").Copy Sheets("Sheet4").Cells(j, "N")
    .Range("B1").Value = .Range("B1").Value + 1
    .Range("C1").Value = .Range("C1").Value + 1
  End With
End Sub

投稿日時 - 2019-02-06 08:11:04

お礼

>転記先の各シートのN列の行数の記録は、どうされますか
それについては、マクロボタンが押される度にN6から最下セルにデータを転記処理出来るようにして頂ければ幸いです。

投稿日時 - 2019-02-06 09:50:47

ANo.3

大先生とかぶりましたので変更しました。
i値、j値の記録にSheet1のセルD3にコメントを設けて記録します。
まずは初期値の設定を行ってD列の開始行、転記先のN列の開始行
の設定を行ってください。
Sub 初期値の設定()
  Dim i As Long, j As Long
  With Sheets("Sheet1").Range("D3")
    If .Comment Is Nothing Then
      .AddComment ""
    End If
    i = InputBox("D列の初期値を入力して下さい。")
    j = InputBox("転記先のN列の初期値を入力して下さい。")
    If i = 0 Or j = 0 Then Exit Sub
    .NoteText i & "-" & j
  End With
End Sub
Sub 転記処理()
  Dim i As Long, j As Long
  With Sheets("Sheet1")
    i = Split(.Range("D3").NoteText, "-")(0)
    j = Split(.Range("D3").NoteText, "-")(1)
    .Cells(i, "D").Copy Sheets("Sheet2").Cells(j, "N")
    .Cells(i, "D").Copy Sheets("Sheet3").Cells(j, "N")
    .Cells(i, "D").Copy Sheets("Sheet4").Cells(j, "N")
    i = i + 1
    j = j + 1
    .Range("D3").NoteText i & "-" & j
  End With
End Sub

投稿日時 - 2019-02-05 23:28:25

お礼

おはようございます。watabe007さん。いつもありがとうございます。スマホにしたばかりで文章を書くのが大変で時々書いた長文が触れ間違って消えてしまいます(笑

B1に予め1000を入れました。これを利用した場合のソースはどうなりますか?

投稿日時 - 2019-02-06 07:09:12

ANo.2

Dim i As Long, j As Long
 ↑どのプロシージャーよりも上に記載してください
Sub Test()
  If i = 0 Then i = 1000 '初期値設定
  If j = 0 Then j = 6 '初期値設定
  With Sheets("Sheet1")
    .Cells(i, "D").Copy Sheets("Sheet2").Cells(j, "N")
    .Cells(i, "D").Copy Sheets("Sheet3").Cells(j, "N")
    .Cells(i, "D").Copy Sheets("Sheet4").Cells(j, "N")
    i = i + 1
    j = j + 1
  End With
End Sub
プックを開いている限り i値、j値は保持しているので
初期値に戻すには↓を行ってください。
Sub i値j値の初期化()
  i = 0
  j = 0
End Sub

投稿日時 - 2019-02-05 22:43:10

ANo.1

最初に
StartSet を実行することで開始行を設定し
その後、
複写する時(ボタン押下時)に
Sample を実行するという解はいかがでしょうか?

Option Explicit

 Dim FromLine As Long
 Dim ToLine As Long

Sub StartSet()
 FromLine = 1000
 ToLine = 6
End Sub

Sub Sample()
 With ThisWorkbook
  .Sheets("Sheet1").Cells(FromLine, 4).Copy .Sheets("Sheet2").Cells(ToLine, 14)
  .Sheets("Sheet1").Cells(FromLine, 4).Copy .Sheets("Sheet3").Cells(ToLine, 14)
  .Sheets("Sheet1").Cells(FromLine, 4).Copy .Sheets("Sheet4").Cells(ToLine, 14)
  FromLine = FromLine + 1
  ToLine = ToLine + 1
 End With
End Sub

投稿日時 - 2019-02-05 22:28:45

お礼

おはようございます。この前にもお世話になりました。ありがとうございます。
このソースはモジュールの一番上に書けば良いでしょうか?

投稿日時 - 2019-02-06 07:25:52

あなたにオススメの質問