こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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

1.Sheet1の1行目に入っているデータをSheet2にコピー
2.Sheet2をコピー
3.Sheet1の1行目を削除
4.上記1~3のマクロを実行するボタンをクリック

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

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

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"

投稿日時 - 2006-10-17 13:05:40

QNo.2478351

すぐに回答ほしいです

質問者が選んだベストアンサー

こんぱんは。Wendy02です。

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

>3.1行目(一人目)のSheetを作り終わったので、1行目のデータを削除して、2人目のデータが1行目にくるようにしております。

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

>2.Sheet2に作られた個人データをコピー(Sheet2を貼付のマスタと置いています)

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

>1.Sheet1の1行目に入っている複数のデータを、Sheet2の連続しない複数のセルにコピー(Sheet2にはグラフが含まれており、Sheet1のデータをコピーすることにより、グラフが作成されます)

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

なお、ループで行う時には、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) でも可能ですが、少し、位置があやふやになってしまいます。

投稿日時 - 2006-10-17 19:34:35

お礼

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

投稿日時 - 2006-10-18 12:53:20

ANo.6

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(6)

ANo.5

こんにちは。

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

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

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

3.Sheet1の1行目を削除
  **シート1のA1だけコピーして、1行目を削除しています。

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

投稿日時 - 2006-10-17 14:11:11

補足

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

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

投稿日時 - 2006-10-17 18:09:13

ANo.4

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

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

---この下から

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

(ここに質問文のマクロをセット)

next
(ここに「End Sub」行をセット)

---ここまで

投稿日時 - 2006-10-17 13:28:46

ANo.3

こんな感じでしょうか

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

投稿日時 - 2006-10-17 13:22:01

ANo.2

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

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

投稿日時 - 2006-10-17 13:22:00

ANo.1

こんにちは。

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

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

(ここに質問文のマクロをセット)

next
(ここに「End Sub」行をセット)

---ここまで

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

投稿日時 - 2006-10-17 13:20:46

あなたにオススメの質問