Excelのワークシートを自動生成２

質問

こんにちは、
昨日、ワークシートの自動生成方法を教えて頂いたものです。
皆様からの回答で逆にやりたいことがはっきりしたので再度質問させてください。

ExcelでSheet1のA列の１行目、２行目・・・入力最終行までの各行の文字を
ワークシート名にした新しいブックを、自動生成したいです。

昨日は作成するワークシート数を指定しましたが
作成ワークシート数が変わることも想定したく思います。
ご教授のほど、何卒よろしくお願いします。ト

回答No.3

Wendy02 · ベストアンサー

こんにちは。

本当は、今まで質問されていたところで、未だに、回答をつけているのですから、そこに補足されても、ちょっと直せばできるはずです。ただ、一通りの回答が得られたなら、お礼を言って締めたほうが、回答者にしこりを残さずに済むと思います。

それと、簡単なマクロが良い、そうでないものはダメということになると、話は違ってくるのですが、せっかく、前回の質問では、marbinさんがされているので、私も敬意をこめて、同じスタイルで作ってみました。

'どちらも、標準モジュールに登録してください。
'-----------------------------------------
'簡易型
Sub MakingSheets1()
　　Dim i As Integer
　　Dim acSh As Worksheet
　　Dim iCnt As Integer
　　Dim shCnt As Integer
　　Dim shName As String
　　Set acSh = Worksheets("Sheet1")
　　iCnt = acSh.Range("A65536").End(xlUp).Row
　　Workbooks.Add
　　shCnt = Worksheets.Count　
　　For i = 1 To iCnt
　　　　shName = acSh.Cells(i, 1).Value
　　　　If shCnt >= i Then
　　　　　　Worksheets(i).Name = shName
　　　　Else
　　　　　　Worksheets.Add After:=Worksheets(Worksheets.Count)
　　　　　　Worksheets(i).Name = shName
　　　　End If
　　Next i
　　Set acSh = Nothing
End Sub

'-----------------------------------------
'エラー回避型
Sub MakingSheets2()
　　Dim i As Long
　　Dim iCnt As Integer
　　Dim shCnt As Integer
　　Dim acSh As Worksheet
　　Dim shName As String
　　Dim n As Integer

　　Set acSh = Worksheets("Sheet1")
　　iCnt = acSh.Range("A65536").End(xlUp).Row
　　If iCnt = 1 Then Exit Sub
　　On Error GoTo ErrHandler
　　n = 1

　　Workbooks.Add
　　shCnt = Worksheets.Count

　　For i = 1 To iCnt
　　　　shName = acSh.Cells(i, 1).Value
　　　　If shCnt >= i Then
　　　　　　Worksheets(i).Name = shName
　　　　Else
　　　　　　Worksheets.Add After:=Worksheets(Worksheets.Count)
　　　　　　Worksheets(i).Name = shName
　　　　End If
　　Next i
　　n = 1
　　Set acSh = Nothing
ErrHandler:
　　If Err.Number = 1004 Then
　　　　Do Until Err.Number = 0
　　　　　　shName = shName & "(" & n & ")"
　　　　　　n = n + 1
　　　　　　Resume
　　　　Loop
　　End If
　　Application.Dialogs(xlDialogSaveAs).Show
End Sub

p.s.上記のコードは、曖昧というか暗黙的です。それが、Excel VBAの書き方かもしれませんが。

お礼

いろいろとアドバイスありがとうございます。
実は、マクロもほとんど初心者、MSN相談箱も始めての利用で
勝手がわからず皆様に失礼をしてしまいました。
申し訳ありません。

マクロサンプル試しました。
うまくいきました。
返す返すありがとうございました。

回答No.2

n-jun

元の質問を貼付けておいた方が楽です。

Excelのワークシートを名前を指定してマクロで自動生成
http://okwave.jp/qa4653039.html

お礼

ありがとうございます。
実はｍｓｎ相談箱を利用するが初めてで勝手がわかりませんでした。
助かります。

回答No.1

kmmk16

一例です

MaxRow = Range("A65536").End(xlUp).Row　’最終行取得
For i = 1 To MaxRow　　’最終行までループ

お礼

ありがとうございます