ExcelのVBAを教えて下さい。 コピーもと、原子表を基にコピペして シート名をE1セルに書かれて

ExcelのVBAを教えて下さい。

コピーもと、原子表を基にコピペして
シート名をE1セルに書かれてる内容と(個人用)と色を付で緑を付けたいと思っています。
どの様にしたら出来るのか教えて下さい。
例えば、
E1セルにメーカー名を(Excel)を入力。
マクロを実行して
Excel(個人用)とシート表示と緑色。
シート名が同じならExcel(個人用)(2)と表示
したいです。
もしくは、Excel-個人用(2)と表示に。
教えて下さい。

質問者からの補足コメント

• プログラマーもっくんさん大変申し訳ないのですがママチャリさんにお伝え願いませんでしょうか。iPhone5でしか見ることが出来なくバッグってル感じです。いつもお世話になっていながら申し訳ございません。とお伝え願います。

    補足日時：2016/12/12 10:19

No.1 ベストアンサー 回答者： ママチャリ 回答日時： 2016/12/10 10:03

こんな感じです。

E1セルにメーカー名が入力されているシートをアクティブにした状態で、マクロを実行してください。

ご参考までに…。シート名として使用できない文字が含まれている場合や31文字を超えた場合の考慮はしたつもりですが、完璧ではないかもしれません。あとは自己責任でお願いします。

Sub Macro1()
Dim NewSheetName As String
Dim NewSheetNo As Long
NewSheetName = Range("E1") & "-個人用"
NewSheetNo = 0
Sheets("原子表").Copy After:=Sheets(Sheets.Count)
With ActiveSheet
.Tab.Color = 5287936
On Error GoTo ErrorHandler
.Name = GetNameNewSheet(NewSheetName, NewSheetNo)
On Error GoTo 0
End With
Exit Sub
ErrorHandler:
NewSheetNo = NewSheetNo + 1
If GetNameNewSheet(NewSheetName, NewSheetNo) = "" Then
MsgBox "名前を変更できませんでした！！"
Resume Next
Else
Resume 0
End If
End Sub

Private Function GetNameNewSheet(NewSheetName As String, NewSheetNo As Long) As String
If NewSheetNo <= 1 Then
GetNameNewSheet = NewSheetName
Else
On Error GoTo ErrorHandler
GetNameNewSheet = Worksheets(NewSheetName).Name
On Error GoTo 0
GetNameNewSheet = NewSheetName & "(" & NewSheetNo & ")"
End If
If Len(GetNameNewSheet) > 31 Then GetNameNewSheet = ""
Exit Function
ErrorHandler:
GetNameNewSheet = ""
End Function

この回答へのお礼

こんにちは。
すみません何も書かれていません。

お礼日時：2016/12/10 12:03

No.2 回答者： ママチャリ 回答日時： 2016/12/10 12:38

No1です。

回答した手前、責任を持ちたいのですが、「何も書かれていません」だけでは事象を把握できません。
残念ですが、離脱させていただきます。

この回答へのお礼

続きを見るから僕が書いた内容だけでした。いつもお世話になっていながら大変厚かましくすみません。

お礼日時：2016/12/10 19:56

No.3 回答者： プログラマーもっくん 回答日時： 2016/12/12 09:35

ママチャリさんがかわいそうです。

せっかく良い回答してくれているのに、、、
質問者も礼儀が必要ですね。。。

この回答へのお礼

ごめんなさい。iPhoneで開いているのですがバグって何も表示しないのです。申し訳ございません。

お礼日時：2016/12/12 10:06