Copiare fogli e rinominarli

Hai un problema con Excel?

Nuova discussione

Copiare fogli e rinominarli
di Lucatop (utente non iscritto) data: 05/07/2015 11:09:14
Grazie in anticipo a chi mi aiuta

Mi serve creare una macro che mi copia il foglio "1" X volte (dove X è il numero di righe con dati nella "Tabella9" del foglio "PROVA").

A seguire la macro deve rinominare i fogli creati con i dati della "Tabella9".
Nella colonna A della tabella ci sono celle formattate testo con numeri a tre cifre. (es. 005)
Nella colonna B della tabella ci sono celle formattate testo con numeri a tre cifre. (es 010)
I miei fogli si dovranno chiarare "A-B" (come da esempio "005-010").

Nota:la tabella è già ordinata per valori delle colonne A e B.

Non metto la macro che ho al momento come base perchè non fa quasi nulla di quello che mi servirebbe.

Grazie

di Raffaele_53 data: 05/07/2015 13:44:22
Ammettiamo che il Tuo foglio si chiama PROVA (Dati da A2:B2 in poi)
Sarranno cancellati tutti i fogli presenti e ricreati. Nel VBA inserisci un modulo e copiagli il codice.

Option Explicit
Sub Crea_Fogli()
Dim ws As Worksheet, ws1 As Worksheet, X As Long, Ur1 As Long
Set ws1 = Sheets("PROVA") 'casomai da cambiare
Application.ScreenUpdating = False
Application.DisplayAlerts = False
  For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> ws1.Name Then
      With ws
        ws.Delete
      End With
    End If
  Next ws
Ur1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
    For X = 2 To Ur1
        ws1.Cells.Copy
        Worksheets.Add
        ActiveSheet.Paste
        ActiveSheet.Name = ws1.Cells(X, 1) & "-" & ws1.Cells(X, 2)
        ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
    Next X
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set ws1 = Nothing
MsgBox "Fatto"
End Sub

di Lucatop data: 05/07/2015 17:43:05
Intanto grazie Raffaele

Ho inserito la macro sotto ma mi dà errore:
Il nome digitano non è un nome di foglio o grafico valido.
Nel debag mi evidenzia la linea:
ActiveSheet.Name = ws1.Cells(X, 1) & "-" & ws1.Cells(X, 2)

Ricapitolando:
Il foglio da copiare si chiama "MASTER"
Il foglio in cui c'è la tabella si chiama "MACRO" (dalla quale ci prendono i dati per capire quanto fogli fare e come rinominarli colonne A e B)
Inoltre non si dovrebbero eliminare i fogli già presenti nella cartella ("MASTER" "MACRO" "RIEPILOGO")
Se possibile i fogli creati dovrebbe uscire dopo quello "MASTER" ordinati come i valori della tabella.

Grazie

Sub CreareFogli()
Dim ws As Worksheet, ws1 As Worksheet, X As Long, Ur1 As Long
Set ws1 = Sheets("MASTER")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
  For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> ws1.Name Then
      With ws
        ws.Delete
      End With
    End If
  Next ws
Ur1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
    For X = 2 To Ur1
        ws1.Cells.Copy
        Worksheets.Add
        ActiveSheet.Paste
        ActiveSheet.Name = ws1.Cells(X, 1) & "-" & ws1.Cells(X, 2)
        ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
    Next X
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set ws1 = Nothing
MsgBox "Fatto"
End Sub

di Raffaele_53 data: 06/07/2015 00:43:15
Hai ricopiato il codice scritto, che vol dir?

>>>Il foglio da copiare si chiama "MASTER" ed >>>Il foglio in cui c'è la tabella si chiama "MACRO"
Se riguardi il post. Sei stato confuzionario nel descrivere il problema. Qual'è il nome da copiare e dove sia la tabella?

Perchè non alleghi nel post (in alto) un Tuo esempio?
di Raffaele_53 data: 06/07/2015 00:57:52
PPS. ammetiamo che sia presente un foglio chiamato 001-002.
Sai che non è possibile ricreare un doppione 001-002
Nel mio pensiero pensavo (elimina tutti gli altri e poi ricrea tutti gli stesi fogli)
Mi sembrava pure una sicurezza, casomai "TU creassi" doppioni di nomi tra A/B nella tabella?
di Lucatop (utente non iscritto) data: 06/07/2015 07:57:14
Ciao
Ho allegato il file excell.
E' nella situazione finale (dopo aver lanciato al macro che mi servirebbe), la condizione iniziale è con solo i primi 3 fogli.

I dati (A+B) non sono mai ripetuti nella tabella (possiamo avere più volte la stessa A o la stessa B, ma mai le stesse A e B nella stessa riga).

di Raffaele_53 data: 06/07/2015 11:10:54
Dopo i Tuoi tre fogli...
Sub Test() non cancella nessun foglio, li crea solamente
Sub Test_ricrea(), li cancella e li ricrea

Ps se desideri verificare se esiste già (il foglio, ...cancellarlo se non esiste nella lista). La macro sarebbe un'altra... Fammi sapere

PPS. Rileggendo desideri copiare il foglio MASTER
Devi modificare la riga---> Sheets("Macro").Cells.Copy in Sheets("Master").Cells.Copy

Option Explicit
Sub Test()
Dim X As Long, Ur1 As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Ur1 = Sheets("Macro").Range("A" & Rows.Count).End(xlUp).Row
    For X = 2 To Ur1
        If Sheets("Macro").Cells(X, 1) = "" Then GoTo Fine
        Sheets("Macro").Cells.Copy
        Worksheets.Add
        ActiveSheet.Paste
        ActiveSheet.Name = Sheets("Macro").Cells(X, 1) & "-" & Sheets("Macro").Cells(X, 2)
        ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
    Next X
Fine:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Fatto"
End Sub


Sub Test_ricrea()
Dim ws As Worksheet, X As Long, Ur1 As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
  For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "MACRO" And ws.Name <> "RIEPILOGO" And ws.Name <> "MASTER" Then
      With ws
        ws.Delete
      End With
    End If
  Next ws
Ur1 = Sheets("MACRO").Range("A" & Rows.Count).End(xlUp).Row
    For X = 2 To Ur1
        If Sheets("Macro").Cells(X, 1) = "" Then GoTo Fine
        Sheets("MACRO").Cells.Copy
        Worksheets.Add
        ActiveSheet.Paste
        ActiveSheet.Name = Sheets("MACRO").Cells(X, 1) & "-" & Sheets("MACRO").Cells(X, 2)
        ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
    Next X
Fine:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Fatto"
End Sub

di Lucatop data: 06/07/2015 14:58:11
La macro sotto funziona, ma mi servirebbe ancora una modifica.
Alla fine della macro mi serve che non selezioni tutte le celle dei fogli appena creati.
Grazie mille.

Sub CreareFogli()
Dim X As Long, Ur1 As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Ur1 = Sheets("Macro").Range("A" & Rows.Count).End(xlUp).Row
    For X = 2 To Ur1
        If Sheets("Macro").Cells(X, 1) = "" Then GoTo Fine
        Sheets("MASTER").Cells.Copy
        Worksheets.Add
        ActiveSheet.Paste
        ActiveSheet.Name = Sheets("Macro").Cells(X, 1) & "-" & Sheets("Macro").Cells(X, 2)
        ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
    Next X
Fine:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
    Sheets("MACRO").Select
    Range("F1").Select
End Sub

di Raffaele_53 data: 06/07/2015 15:50:47
Prima di Next X
Metti cells(1,1).activate, oppure Range("A1").activate (solo quella cella che desideri)

di Lucatop data: 06/07/2015 18:04:39
Risolto funziona
Grazie della disponibilità Raffaele

Sotto il codice finale

Sub CreareFogli()
Dim X As Long, Ur1 As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Ur1 = Sheets("Macro").Range("A" & Rows.Count).End(xlUp).Row
    For X = 2 To Ur1
        If Sheets("Macro").Cells(X, 1) = "" Then GoTo Fine
        Sheets("MASTER").Cells.Copy
        Worksheets.Add
        ActiveSheet.Paste
        ActiveSheet.Name = Sheets("Macro").Cells(X, 1) & "-" & Sheets("Macro").Cells(X, 2)
        ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
    Range("A10").Select
    Next X
Fine:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
    Sheets("MACRO").Select
    Range("F1").Select
End Sub

Vuoi Approfondire?