エクセル（マクロ）でシートを連続コピーしてリストでシート名の付け方を教えて下さい。

マクロ初心者です。

次のリストからマクロを実行した際にリスト名のシートを作成する方法を教えていただけないでしょうか。
　 　Ａ　　Ｂ　　Ｃ　…　
１ 県名
２ 北海道
３ 青森
４ 秋田
５ 岩手
６ 山潟
７ 新潟
８ 宮城
９ （空白）
10（空白）

１～10までのリストを以下のマクロで実行すると９と10が空白の為、「実行時エラー’1004’：アプリケーション定義またはオブジェクト定義のエラーです。」が実行後に表示されます。空白があってもエラーが出ないようなマクロを作成するにはどのようにしたらよいでしょうか？
また、実行後にリスト名が誤っていて再度マクロを実行した際に誤っているところだけ別にシートが作成されて誤っていないところはそのままというようなマクロは作成できるものでしょうか？
（例）Ａ-6 山潟 → 山形に訂正し、再度マクロを実行した際に山形というシートだけが追加作成される。

Sub リストから連続シート作成()
Dim 県名 As Range
For Each 県名 In Worksheets("リスト").Range("A2：A10")
Worksheets("原本").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = 県名.Value
ActiveSheet.Range("A1") = 県名.Value
Next 名前
End Sub

無理なことを言っているかもしれませんが詳しい方、どうかよろしくお願いいたします。

No.1 ベストアンサー 回答者： tom04 回答日時： 2020/05/28 21:28

こんばんは！

＞空白があってもエラーが出ないような・・・
に関して

A2～A10セルと決まっているのですかね？
そうであれば
＞For Each 県名 In Worksheets("リスト").Range("A2：A10")
の次に
＞If 県名 <> "" Then
を

＞Next 名前　　←　Next 県名　では？
の前に
＞End If
をそれぞれ追加してみてください。

次にシート名の変更についてですが、
Excel的には「山潟」は「山形」の間違いだという判別はできません。
どこかに正誤表があって、それを参照するのであれば可能です。

まずはこの程度で。m(_ _)m

この回答へのお礼

早々に回答いただき、お礼が遅くなり大変申し訳ありませんでした。自分でも教えらてとおりやってみたらエラーが出なくなり、大変助かりました。

お礼日時：2020/05/31 15:04

No.4 回答者： ママチャリ 回答日時： 2020/05/29 22:09

空白を判定するより、エラートラップしちゃった方が、良いような気がします。

シート名に使えない文字（例えば、"/"）もあるので、すべて判断していると、気が狂いそうです（ちょっと大げさ）
こんな感じでです。

Sub リストから連続シート作成()
Dim 県名 As Range
For Each 県名 In Worksheets("リスト").Range("A2：A10")
Worksheets("原本").Copy After:=Worksheets(Worksheets.Count)
On Error Resume Next
ActiveSheet.Name = 県名.Value
If Err.Number = 1004 Then
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Else
ActiveSheet.Range("A1") = 県名.Value
End If
On Error GoTo 0
Next 県名
End Sub

この回答へのお礼

このたびはご返事いただき大変有難うございました。
考え方でVBAの組み方もいろいろあるんだなと思って感心するばかりです。
これから僕も少しずつ勉強していきたいと思っています。
ご教授いただき、有難うございました。

お礼日時：2020/05/31 14:58

No.3 回答者： Qchan1962 回答日時： 2020/05/29 02:40

こんばんは、

空白データの処理は、すでに回答されている通りIf文で条件分離すれば良いと思います。
しかし、
＞実行後にリスト名が誤っていて再度マクロを実行した際に誤っているところだけ別にシートが作成されて誤っていないところはそのままというようなマクロは作成できるものでしょうか？

マクロは、プログラムなので、論理的説明が出来れば、作成は可能と思います。手法は別として。
ご質問の場合、何が誤りか？判断できない所が問題になります。。ですので、ご質問の流れを考え、誤っていると言うのは、
既存シート名と新規シート名（リスト）の差異を指しているものと推察します。
であれば、リストの内容と既存のシート名を照合して、シート名にあるものは、実行せず、シート名に無くリストにあるものを
シート名としてシート作成を行えば良い事になります。

疑問としては、いわゆる間違いと称するシートをどう扱えば良いかと言う事、削除してしまっても良いのでしょうか。
間違えにおそらく入力されているデータはどうするのか？まあ、それこそどこに移せば良いか判断が出来ないかと思いますが、、

なされたい事は、作成のみのようですね。
的外れかもしれませんが、サンプルを示します。ぱっと見、難しい内容になってしまったので、
もっと簡単に考えた方が良いのかも知れません。。取り敢えず、削除部分は、コメントアウトしてあります。

試す場合は、小さなブックで検証してください。
標準モジュールに、実行プロシージャは、　リストから連続シート作成（）です。

Option Explicit
Sub リストから連続シート作成()
Dim myList(), mySht()
Dim Old_name As Variant, New_name As Variant
Dim i As Long, j As Long, LastRow As Long
　　With Worksheets("Sheet1")
　　'質問に合わせて10行目まで（コメント部は最終行
　　　　LastRow = 10　　　　 '.Cells(Rows.Count, 1).End(xlUp).Row
　　　　ReDim mySht(1 To Worksheets.Count)
　　　　ReDim myList(1 To LastRow - 1)
　　　　For i = 2 To LastRow
　　　　　　If .Cells(i, 1) <> "" Then
　　　　　　　　myList(i - 1) = .Cells(i, 1)
　　　　　　End If
　　　　Next
　　End With
　　For i = 1 To Worksheets.Count
　　　　If Sheets(i).Name <> "原本" Then
　　　　　　j = j + 1
　　　　　　mySht(j) = Sheets(i).Name
　　　　End If
　　Next
　　'　　On Error Resume Next
　　Old_name = AryCHK(myList, mySht)　　'削除の為のチェック
　　Application.ScreenUpdating = False
　　Application.DisplayAlerts = False
　　' リストに無いシートを削除
　　'　　If IsArrayEx(Old_name) = 1 Then
　　'　　　　If Worksheets.Count > UBound(Old_name) Then
　　'　　　　　　Sheets(Old_name).Delete
　　'　　　　End If
　　'　　End If
　　Application.DisplayAlerts = True
　　New_name = AryCHK(mySht, myList)　　'作成の為のチェック
　　If IsArrayEx(New_name) = 1 Then
　　　　For i = LBound(New_name) To UBound(New_name)　　'シート名にないシートをリストから作成
　　　　　　Worksheets("原本").Copy After:=Worksheets(Worksheets.Count)
　　　　　　ActiveSheet.Name = New_name(i)
　　　　　　ActiveSheet.Range("A1") = New_name(i)
　　　　Next
　　End If
　　Application.ScreenUpdating = True
End Sub

'配列に存在するかチェック（戻り値は存在しない値）
Function AryCHK(Ary, CHK) As Variant()
Dim i As Long, n As Long: n = 0
Dim varResult As Variant, return_Array()
　　For i = 1 To UBound(CHK)
　　　　varResult = Filter(Ary, CHK(i))
　　　　If UBound(varResult) <> -1 Then
　　　　Else
'Debug.Print CHK(i)
　　　　　　If CHK(i) <> "" Then
　　　　　　　　ReDim Preserve return_Array(n)
　　　　　　　　return_Array(n) = CHK(i)
　　　　　　　　n = n + 1
　　　　　　End If
　　　　End If
　　Next
　　AryCHK = return_Array
End Function
Function IsArrayEx(varArray As Variant) As Long
　　On Error GoTo ERROR_
　　If IsArray(varArray) Then
　　　　IsArrayEx = IIf(UBound(varArray) >= 0, 1, 0)
　　Else　　　　　　　　　　 '1:配列;0:空の配列;-1:Not配列
　　　　IsArrayEx = -1
　　End If
　　Exit Function
ERROR_:
　　If Err.Number = 9 Then
　　　　IsArrayEx = 0
　　End If
End Function

この回答へのお礼

このたびはご返事いただき大変有難うございました。
今回の質問でこんなに考えていただき有難うございました。
今回教えていただいたVBAの内容は初心者の僕にとってまだ理解できない
ですがこれから少しずつ勉強して皆様のように組めればいいなと思ってます。
大変有難うございました。

お礼日時：2020/05/31 15:00

No.2 回答者： fujillin 回答日時： 2020/05/28 21:34

こんばんは

＞９と10が空白の為、「実行時エラー～～～」が実行後に表示されます
そこまで分析ができているのですから、「セルの値が空白だったら処理をスキップする」（＝空白ではないときだけ実行する）ようになさってはいかがでしょうか。

この回答へのお礼

このたびはご回答いただき有難うございます。
インターネットで自己解決しようと思いましたが初心者の自分にとってはなかなか難しく皆様の回答で解決することができ大変助かりました。

お礼日時：2020/05/31 15:03