エクセルのマクロ：連続動作を空白行で終了する方法

質問

XP・Excel2003使用のマクロ素人です。
エクセルのマクロを使って以下のマクロを作りました。

１．Sheet１の１行目に入っているデータをSheet２にコピー
２．Sheet２をコピー
３．Sheet１の１行目を削除
４．上記１～３のマクロを実行するボタンをクリック

作業を繰り返し行いたかったので、（４）の「マクロボタンをクリック」という作業もマクロに組み込んでみたのですが、空白行でも延々に実行されてしまいます。

【Sheet１に入っているデータが空白になったら作業を止める】というマクロはどのように書けばいいのでしょうか？
マクロの作り方が根本的に間違っていましたら、あわせてご指摘下さい。
宜しくお願い致します。

Range("A1").Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
Sheets("Sheet2").Select
Application.CutCopyMode = False
Sheets("Sheet2").Copy After:=Sheets(3)
Sheets("Sheet1").Select
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("Sheet1").Select
Application.Run "Book1!Macro1"

回答No.6

Wendy02 · ベストアンサー

こんぱんは。Wendy02です。

私自身としては、あまり細かい部分には、立ち入れないような部分も感じますし、本当におせっかいになってしまうのですが・・・。少し、アドバイスをさせてください。

>３．１行目（一人目）のSheetを作り終わったので、１行目のデータを削除して、２人目のデータが１行目にくるようにしております。

手作業の場合は、確かにこのようにしてよいのですが、マクロで作成する場合は、一括して削除したほうがよいと思うのです。まあ、もちろん、全部を削除してしまう、ということには、私は、多少の抵抗は感じますが。そうした元データを削除するのは、念には念を入れて削除するようにしたほうがよいのではないか、と思います。

>２．Sheet２に作られた個人データをコピー（Sheet２を貼付のマスタと置いています）

これは、どこかに個人名など、それをシート名にする名称がないのでしょうか？単にコピーするなら、貼付のマスタ(2),貼付のマスタ(3),, などなってしまいます。ActiveSheet.Name = ○○○で、名前が付けられます。

>１．Sheet１の1行目に入っている複数のデータを、Sheet２の連続しない複数のセルにコピー（Sheet２にはグラフが含まれており、Sheet１のデータをコピーすることにより、グラフが作成されます）

たぶん、それ相応のデータがないと、グラフにはなりませんが、コピーする時に、横のデータを、縦のデータの並びにしてあげたら、見やすいような気がします。

なお、ループで行う時には、Cells(i,1) で行うと便利です。

私なりの想像でサンプルを作ってみましたが、必ずしもご要望とは一致しません。
それでも、部分的に参考にならないでしょうか？

例：
横のものを縦にして張り付ける
'なるべく標準モジュールでお試してください。

Sub CopyCells2Sheet()
　Dim i As Long
　On Error GoTo ErrHandler
　With Worksheets("Sheet1")
　　For i = 1 To .Range("A65536").End(xlUp).Row
　　　.Range(.Cells(i, 1), .Cells(i, 256).End(xlToLeft)).Copy
　　　'横のものを縦にして張り付ける(Transpose が縦横変換)
　　　Worksheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteAll,Transpose:=True

　　　Application.CutCopyMode = False

　　　Worksheets("Sheet2").Copy After:=Sheets(Sheets.Count)
　　　'シート1のA列のデータをシートの名前にする
　　　Sheets(Sheets.Count).Name = .Cells(i, 1).Value
　　Next i
　　.Select　　'シートのセレクト
　　'元データの削除
　　.Range("A1").CurrentRegion.Select
　　If MsgBox("データを削除してよろしいですか？", vbInformation + vbOKCancel) = vbOK Then
　　　Selection.ClearContents
　　　.Range("A1").Select
　　End If
　End With
　Exit Sub
ErrHandler:
　'シート名が同じものがある時のエラー処理
　MsgBox Err.Description
End Sub

なお、少し、上記のコードをコメントすると、Sheet とWorksheet の意味が違います。

Worksheets("Sheet2").Copy After:=Sheets(Sheets.Count)

Sheets(Sheets.Count)というのは、シートの種類に関係なくシートを数えて、その後ろにワークシートを貼り付ける、という意味です。それをAfter:=Worksheets(Worksheets.Count) でも可能ですが、少し、位置があやふやになってしまいます。

お礼

アドバイスありがとうございます。
想像で作っていただいたサンプルの大部分を使用して、理想的なマクロを組む事ができました。コードのことなど本当に何もわからないので、とても参考になりました。これから少しずつ上達していきます。
また困ったことがありましたら、助けてください。

回答No.5

Wendy02

こんにちは。

私には、コードというよりも元のマクロの意図が良く分かりません。

１．Sheet１の１行目に入っているデータをSheet２にコピー
　　**マクロでは、A1 を どこかの場所にコピーしています。繰り返す必要性があるのか、分かりません。

２．Sheet２をコピー
　　**シート2を、シート3の後ろにコピーしています。

３．Sheet１の１行目を削除
　　**シート1のA1だけコピーして、1行目を削除しています。

それを繰り返したら、場合によっては、Excelがハングするのではないでしょうか？もう少し、そのマクロのタスクがきちんと整理されていなければ、コードは書けても、実用にはならないように思います。

補足

説明不足でした。簡略化しすぎました。申し訳ありません。
具体的に言いますと、テスト結果の一覧表を個人別報告書に仕上げる作業をしたいのです。
Sheet１にはテスト受検者全員の結果（１人分で１行）が一覧表で入っています。これらを報告書用に１Sheetに１人ずつの個人データを入れたいのです。
１．Sheet１の1行目に入っている複数のデータを、Sheet２の連続しない複数のセルにコピー（Sheet２にはグラフが含まれており、Sheet１のデータをコピーすることにより、グラフが作成されます）
２．Sheet２に作られた個人データをコピー（Sheet２を貼付のマスタと置いています）
３．１行目（一人目）のSheetを作り終わったので、１行目のデータを削除して、２人目のデータが１行目にくるようにしております。
※これは、連続してマクロを使うために設定しました

なにぶんマクロ素人な為、とんちんかんな質問かもしれませんがアドバイスをお願い致します。マクロを作る際は最初[ツール]－[マクロ]－[新しいマクロを作成]で作ってから、修正を加えております。

回答No.4

Knl_Panic

すみません、No.1の訂正です。

EOFはプロパティ名にあるので、変数として適切でありませんでした。
次のように訂正します。

---この下から

（ここに「Sub」行をセット）
LstROW = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
For i = 1 To LstROW

（ここに質問文のマクロをセット）

next
（ここに「End Sub」行をセット）

---ここまで

回答No.3

merlionXX

こんな感じでしょうか

Sub test01()

With Sheets("Sheet1") 'Sheet1について

Do While .Range("A1").Value <> "" 'A1が空白でない間

.Range("A1").Copy 'A1をコピー
Sheets("Sheet2").Range("A1").PasteSpecial ' Sheet2のA1に貼り付け
Application.CutCopyMode = False
Sheets("Sheet2").Copy After:=Sheets(Sheets.Count) ' Sheet2をコピーし最後のシートにする
.Rows("1:1").Delete Shift:=xlUp ' 1行目を削除

Loop '実行を繰り返す

End With 'Sheet1について,おわり

End Sub

回答No.2

driverII

普通はループを使って、実現します。

----------------------------------
Dim fEnd As Boolean
fEnd = False
While fEnd = False
処理
If Range("A1").Value = "" Then fEnd = True
Wend
--------------------------

回答No.1

Knl_Panic

こんにちは。

そのマクロを以下の行で挟んでみてください。

---この下から
（ここに「Sub」行をセット）
EOF = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
For i = 1 To EOF

（ここに質問文のマクロをセット）

next
（ここに「End Sub」行をセット）

---ここまで

これでデータのある行数回分だけ処理が繰り返されると思います。
以上、よろしかったら試してみてください。