[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『元データから転記先データへ２行空けながら最終行までコピーしたい』（ゆぅー）
コピー転記のマクロを教えてください。
元データには、「B3セル〜J3」までデータが入っています。 データ数は、３００件
転記先シートには、１行転記したら２行空けて元データの「B4〜J4」を 転記していきたいです。
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
１）転記先シートの何列・何行から元データを移していけばいいですか？ ２）元データを転記したら、データは消しますか？ それとも、転記済マークでもつけますか？ （稲葉） 2017/06/08(木) 12:49
転記先シートは、「C4〜K4」まで、でした。
元データは、消したくないので転記済マークが良いです。
宜しくお願いいたします。
（ゆぅー） 2017/06/08(木) 13:05
このような形でいかがでしょう？ 転記済マークの指定がなかったので、元データのB列が赤くなっているところは済としました。 2行おき は Offset(3) を指しています。 3行おきなら Offset(4)にしてください。 B3〜J3 は Resize(,9) を指しています。 範囲がKまで広がるなら、Resize(,10)等適宜変更してください。 データ数３００件 は 動的に末端を探しています。 手作業で行う場合、元データシートのB列の一番最後の行から、Ctrl+↑を押したセルまで繰り替えす、という処理です。 Cells(Rows.Count, "B").End(xlUp) のコードがそれに当たります。
その他わからないことがあれば聞いてください。
Sub yuxu()
Dim n As Long
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim r1 As Range
Dim r2 As Range
Set WS1 = Sheets("sheet1") '元データシート名を入れる
Set WS2 = Sheets("sheet2") '転記先シート名を入れる
For n = 3 To WS1.Cells(Rows.Count, "B").End(xlUp).Row
Set r1 = WS1.Cells(n, "B")
Set r2 = WS2.Cells(Rows.Count, "C").End(xlUp)
If r1.Interior.Color <> vbRed Then
r2.Offset(3).Resize(, 9).Value = r1.Resize(, 9).Value
r1.Interior.Color = vbRed
End If
Next n
End Sub
（稲葉） 2017/06/08(木) 13:45
For n = 3 To WS1.Cells(Rows.Count, "B").End(xlUp).Row
Set r1 = WS1.Cells(n, "B")
Set r2 = WS2.Cells(Rows.Count, "C").End(xlUp)
の、「ｒ２」の所で、常に「セット」を読みに行くので「ｒ２」に入っているものが
「Ｃ３」セルのままになりその結果「Ｃ６」セルへ上書きされ元データはどんどん転記済
となってしまいます。
Ｓｅｔ〜を、Ｆｏｒの前に持っていくとエラーします。
（ゆぅー） 2017/06/08(木) 14:57
こちらでは再現できません。 テスト環境を提示しますので、違いをご説明ください。
元データ
|[A]|[B]|[C]|[D]|[E]|[F]|[G]|[H]|[I]|[J]|[K]
[1] | | | | | | | | | | |
[2] | | | | | | | | | | |
[3] | | 1| 1| 1| 1| 1| 1| 1| 1| 1|
[4] | | 2| 2| 2| 2| 2| 2| 2| 2| 2|
[5] | | 3| 3| 3| 3| 3| 3| 3| 3| 3|
[6] | | 4| 4| 4| 4| 4| 4| 4| 4| 4|
[7] | | 5| 5| 5| 5| 5| 5| 5| 5| 5|
[8] | | 6| 6| 6| 6| 6| 6| 6| 6| 6|
[9] | | 7| 7| 7| 7| 7| 7| 7| 7| 7|
[10]| | 8| 8| 8| 8| 8| 8| 8| 8| 8|
[11]| | 9| 9| 9| 9| 9| 9| 9| 9| 9|
転記シート
|[A]|[B]|[C]|[D]|[E]|[F]|[G]|[H]|[I]|[J]|[K]|[L]
[1] | | | | | | | | | | | |
[2] | | | | | | | | | | | |
[3] | | | | | | | | | | | |
[4] | | | 1| 1| 1| 1| 1| 1| 1| 1| 1|
[5] | | | | | | | | | | | |
[6] | | | | | | | | | | | |
[7] | | | 2| 2| 2| 2| 2| 2| 2| 2| 2|
[8] | | | | | | | | | | | |
[9] | | | | | | | | | | | |
[10]| | | 3| 3| 3| 3| 3| 3| 3| 3| 3|
[11]| | | | | | | | | | | |
[12]| | | | | | | | | | | |
[13]| | | 4| 4| 4| 4| 4| 4| 4| 4| 4|
（稲葉） 2017/06/08(木) 15:25
稲葉様 ありがとうございます。
元データ
|[A]|[B]|[C]|[D]|[E]|[F]|[G]|[H]|[I]|[J]|[K]
[1] | | | | | | | | | | |
[2] | | | | | | | | | | |
[3] | | 1| |
[4] | | | 2| |
[5] | | | | 3|
[6] | | | | | 4|
[7] | | | | | | 5| |
[8] | | | | 6| |
[9] | | | | | 7| |
[10]| | | | | | 8| |
[11]| | | 9| |
元データが、こんな感じです。 全てに、データが入ってるか入ってないかで動作は変わるのでしょうか？ （ゆぅー） 2017/06/09(金) 09:38
変わります。 （稲葉） 2017/06/08(木) 13:45の投稿で ＞手作業で行う場合、元データシートのB列の一番最後の行から、Ctrl+↑を押したセルまで繰り替えす、という処理です。 と説明しました。 試していただけましたか？
元データシートはデータ以外に何か入力されていますか？ 特にデータの最終行より後ろに。 データ範囲を調べるために必要な情報です。
（稲葉） 2017/06/09(金) 10:43
暫定で修正あげておきます。
Sub yuxu()
Dim n As Long
Dim j As Long
Dim r As Range
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim r1 As Range
Dim r2 As Range
Set WS1 = Sheets("sheet1") '元データシート名を入れる
Set WS2 = Sheets("sheet2") '転記先シート名を入れる
Set r = WS2.Cells.Find(What:="*", SearchDirection:=xlPrevious)
If r Is Nothing Then
j = 4
Else
j = r.Row + 3
End If
For n = 3 To WS1.Cells.Find(What:="*", SearchDirection:=xlPrevious).Row
Set r1 = WS1.Cells(n, "B")
Set r2 = WS2.Cells(j, "C")
If r1.Interior.Color <> vbRed Then
r2.Offset(3).Resize(, 9).Value = r1.Resize(, 9).Value
r1.Interior.Color = vbRed
j = j + 3
End If
Next n
End Sub
（稲葉） 2017/06/09(金) 11:46
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.