エクセルについて教えて下さい。

質問

エクセルのSheet1に顧客データが20000件くらいありそのデータを1000件ずつ別のシートにコピー＆ペーストするマクロを作りたいのですがどうしたら良いのでしょうか？

回答No.3

imogasi · ベストアンサー

Sub test01()
Dim nm As String
For i = 1 To 20000 Step 1000
nm = Worksheets.Add.Name
MsgBox i
MsgBox nm
Worksheets("sheet1").Select
Worksheets("sheet1").Range(Cells(i, 1), Cells(i + 999, 10)).Copy
Worksheets(nm).Select
ActiveSheet.Paste
Next i
End Sub
本番変更点
（１）For i = 1 To 20000 Step 1000の２００００を本当の行数にする。
（２）「999, 10)).Copy」の10を最も右側にデータがある列を数字化する。Ａ列なら１、Ｃは３、Ｇは７、ｊならば１０です。類推でわかりますよね。
ここはその前行とは１行にしてください。
既出の回答と同じことをしていると思いますが、文字数が
少なく、印象が随分違うでしょう。コーディング規則からは既出の回答の方がよいと思いますが。

お礼

回答ありがとうございます。
おかげで解決することができました。
勉強になりました。
本当にありがとうございました。

回答No.2

vbafriend

初めまして。サンプルマクロを組んでみました。参考にしてみて下さい。
もし操作方法等がご不明な場合はお知らせ下さい。ご説明させていただきます。

Sub Test()

Dim i As Integer
Dim myWsc As Integer
Dim myCnt As Integer
Dim myCounter As Integer
Dim myRow As Integer

myCnt = 1: myCounter = 1
Do Until myCounter = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
myCnt = myCnt + 1
myWsc = Worksheets.Count
If myWsc < myCnt Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
End If

Do
myCounter = myCounter + 1
If myCounter Mod 1000 = 1 Then Exit Do
Worksheets(1).Cells.Copy
Worksheets(myCnt).Cells.Select
Selection.PasteSpecial Paste:=xlFormats
myRow = Worksheets(myCnt).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets(1).Rows(myCounter & ":" & myCounter).Copy Destination:=Worksheets(myCnt).Rows(myRow & ":" & myRow)
Loop

Loop

End Sub

補足

回答ありがとうございました。
早速やってみたのですがデータの1件目が抜けてしまいます。
初心者なのでどこをどうしたら良いのかわかりません。
何度も恐縮ですが教えて頂けないでしょうか？

回答No.1

taknt

まず、新しいマクロの記録とやります。
それで、コピー　＆ ペーストの処理をして
記録を終了します。

これで、作成したマクロを修正すればＯＫです。

補足

回答ありがとうございます。
その修正の部分で1000件ずつというのをどのように指定したら
良いのかがわからないのです。
もう少し詳しく教えて頂けないでしょうか