Excel: Creare nuovo foglio da foglio base

[Francesco53]

Buonasera a tutto il Forum,
ho la seguente necessità, (ho cercato nei post passati non sono riuscito a trovare la soluzione).
Ho un foglio.base in cui creo uno schema dati, ho la necessità tramite una macro di automatizzare la creazione
di una copia del foglio.base con un nome da me digitato tramite user.form.
Grazie a chi può aiutarmi.
Francesco

[Anthony47]

Registra una macro mentre crei una copia del tuo foglio tramite il comando Menu /Modifica /Sposta o copia foglio...
Poi userai un InputBox per chiedere il nome del nuovo foglio e rinominare.

Se non risolvi con questo spunto allora posta ancora spiegando dove sei arrivato.

Ciao

[Francesco53]

Ciao Anthony,
avevo già provato quanto da te richiesto e questo è il risultato ottenuto:

Codice: Seleziona tutto

Sub Macro1()
UserForm1.Show
    NM = UserForm1.TextBox1.Text
        Sheets("Base").Select
        Sheets("Base").Copy After:=Sheets(1)
        Sheets("Base (2)").Select
        Sheets("Base (2)").Name = "NM"
End Sub

come sicuramente capirai la prima volta mi crea un foglio di nome NM e non come digitato nella user.form,
la seconda volta va in blocco. Purtroppo non riesco ad andare oltre.
Francesco

[Flash30005]

Vediamo se così ti va ancora in blocco!

Codice: Seleziona tutto

Sub CopiaFoglio()

Dim NomeFoglio As String
Dim MioNome As String
Dim NomeO As Boolean
Dim LeString
LeString = ":/?*[]"
NomeB = Foglio1.Name
'NomeB = "Base" '<<<< se Base non è il foglio1 allora togli il commento a questa riga e commenta o togli la precedente
Do
NomeO = True
NomeFoglio = InputBox("Qual è il nome per" _
+ vbCrLf + "il foglio ?", _
"dare nome ", MioNome)
If NomeFoglio <> "" Then
'verifica se il nome non esiste...
For a = 1 To ActiveWorkbook.Worksheets.Count
If UCase(NomeFoglio) = UCase(Worksheets(a).Name) Then
supp = MsgBox( _
"Un foglio con questo nome è già presente," _
+ vbCrLf + vbCrLf + _
"volete sostituirlo ?.", vbYesNo + vbOKOnly, _
"Nome già usato")
If supp = vbYes Then
Application.DisplayAlerts = False
Worksheets(NomeFoglio).Delete
Application.DisplayAlerts = True
Exit For
Else
NomeO = False
MioNome = NomeFoglio
Exit For
End If
End If
Next

'verifica che il nome non ha più di 31 caratteri...
If Len(NomeFoglio) > 31 Then
MsgBox "Il numero di carattere (" & _
Len(NomeFoglio) & ") del nome è troppo grande" _
+ vbCrLf + " il massimo è (31) per excel.", _
vbCritical + vbInformation, "Nome troppo longo"
NomeO = False
MioNome = NomeFoglio
End If

'verifica se nel nome non ci sono caratteri vietati...
For a = 1 To Len(LeString)
If InStr(1, NomeFoglio, Mid(LeString, a, 1), vbTextCompare) > 0 Then
MsgBox "I caratteri seguenti : " & _
LeString & " sono vietati" _
+ vbCrLf + "nel nome del foglio.", _
vbCritical + vbOKOnly, "carattere vietato"
NomeO = False
MioNome = NomeFoglio
Exit For
End If
Next
Else
Exit Sub
End If
Loop Until NomeO = True
Sheets(NomeB).Copy after:=Worksheets(Worksheets.Count)
Sheets(NomeB & " (2)").Name = NomeFoglio

End Sub


Se non ti piace il messagebox poi sostituirlo con l'userform .

Ciao

[Francesco53]

Grazie Flash è perfetta.
Francesco