Excel2007で質問です。

質問

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

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

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

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

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

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

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

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

回答No.5

watabe007 · ベストアンサー

>マクロボタンが押される度に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

お礼

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

回答No.4

watabe007

>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

お礼

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

回答No.3

watabe007

大先生とかぶりましたので変更しました。
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

お礼

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

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

回答No.2

watabe007

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

お礼

ありがとうございました。

回答No.1

HohoPapa

最初に
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

お礼

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