ここから本文です

エクセル（VBA）マクロで１行おきに、別シートにコピーする方法。

プロフィール画像

unp********さん

2012/4/914:54:29

エクセル（VBA）マクロで１行おきに、別シートにコピーする方法。

以下のようにSheet1 に入力されているとします。

【Sheet1】
1 山田 太郎 TEL 住所 。。。。など
2 鈴木 花子
3 佐藤 真一
4 田中 武
5 後藤 正美

これを、以下のように１行おきに、Sheet2 と Sheet3
へ振り分けてコピーたいのですが、

【Sheet2】

1 山田 太郎 TEL 住所 。。。。など
2 佐藤 真一
3 後藤 正美


【Sheet3】
1 鈴木 花子 TEL 住所 。。。。など
2 田中 武



これが可能なVBAをご教示いただけないでしょうか？

なお、行数は上記では５行しか書いていませんが、
数千行ぐらいのシートになります。

どうぞ宜しくお願いいたします。

閲覧数：
7,273
回答数：
3
お礼：
50枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

han********さん

編集あり2012/4/916:21:44

私ならこんな感じにするかな。

Sub Sample1()
Dim i As Long

Application.ScreenUpdating = False
With Worksheets("Sheet1")
For i = 1 To (.Cells(Rows.Count, 1).End(xlUp).Row + 1) \ 2
.Rows(i * 2 - 1).Copy Worksheets("Sheet2").Rows(i)
.Rows(i * 2).Copy Worksheets("Sheet3").Rows(i)
Next i
End With
Application.ScreenUpdating = True
End Sub

【追記】
書式を除いて値だけコピーできればよいなら、こちらが速いです。

Sub Sample2()
Dim i As Long

Application.ScreenUpdating = False
With Worksheets("Sheet1")
For i = 1 To (.Cells(Rows.Count, 1).End(xlUp).Row + 1) \ 2
Worksheets("Sheet2").Rows(i).Value = .Rows(i * 2 - 1).Value
Worksheets("Sheet3").Rows(i).Value = .Rows(i * 2).Value
Next i
End With
Application.ScreenUpdating = True
End Sub

違反報告

この質問は投票によってベストアンサーに選ばれました！

ベストアンサー以外の回答

1〜2件/2件中

並び替え：回答日時の
新しい順
|古い順

プロフィール画像

msk********さん

2012/4/915:16:34

一例です。
コピー列は１０列としています。

Sub sample()
Dim i As Long, st2cnt As Long, st3cnt As Long
Set st2 = Sheets("sheet2")
Set st3 = Sheets("sheet3")
Application.ScreenUpdating = False
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
With Cells(i, "A").Resize(1, 10)
If i Mod 2 Then
st2cnt = st2cnt + 1
st2.Cells(st2cnt, "A").Resize(1, 10) = .Value
Else
st3cnt = st3cnt + 1
st3.Cells(st3cnt, "A").Resize(1, 10) = .Value
End If
End With
Next
Application.ScreenUpdating = True
End Sub

違反報告

プロフィール画像

ton********さん

2012/4/915:01:46

ちなみに、作業列を使って1行目に「○」2行目に「☓」とでも入れてオートフィル。
オートフィルタでどっちかを表示してコピー…の手作業でも
そう大変じゃない気がするけど、マクロがいいのかな？

上記をマクロの記録取るだけでも自動化は出来そうだけど。

違反報告

あわせて知りたい

この質問につけられたタグ

みんなで作る知恵袋　悩みや疑問、なんでも気軽にきいちゃおう！

Q&Aをキーワードで検索：

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる