buongiorno a tutti,
ho un foglio con circa 15.000 righe ed avrei bisogno di una macro che mi copi 1000 righe per volta e le incolli su un nuovo foglio nominandolo con Step1; Step2 e cosi' via......
grazie a tutti
Moderatori: Anthony47, Flash30005
Sub Macro1()
'
' Macro1 Macro
'
'
Rows("2:1001").Select
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
Sheets("Foglio2").Name = "Step_01"
Sheets("Foglio1").Select
Rows("1002:2001").Select
Application.CutCopyMode = False
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
Sheets("Foglio3").Name = "Step_02"
End Sub
Sub CopiaMilleRighe()
Dim MieRighe As Long, GruppiRighe As Long, UltimaRiga As Long, i As Integer, NomeFoglio As String
MieRighe = 1000
Application.ScreenUpdating = False
With ActiveSheet
UltimaRiga = .Range("A" & .Rows.Count).End(xlUp).Row
For GruppiRighe = 2 To UltimaRiga Step MieRighe
Sheets.Add after:=ActiveSheet
.Range("A" & GruppiRighe).Resize(MieRighe).EntireRow.Copy Range("A1")
Columns.AutoFit
Next GruppiRighe
For i = 2 To Application.Sheets.Count
NomeFoglio = "Step "
Application.Sheets(i).Name = NomeFoglio & i - 1
Next
.Activate
End With
Application.ScreenUpdating = True
End Sub
Sub CopiaMilleRighe()
Dim MieRighe As Long, GruppiRighe As Long, UltimaRiga As Long, i As Integer, NomeFoglio As String
'
MieRighe = 1000
'
Application.ScreenUpdating = False
With ActiveSheet
UltimaRiga = .Range("A" & .Rows.Count).End(xlUp).Row
For GruppiRighe = 2 To UltimaRiga Step MieRighe
Sheets.Add after:=ActiveSheet
.Range("A" & GruppiRighe).Resize(MieRighe).EntireRow.Copy Range("A1")
Columns.AutoFit
ActiveSheet.Name = "Step_" & Format(i + 1, "00") 'MMM
i = i + 1 'MMM
Next GruppiRighe
.Activate
End With
Application.ScreenUpdating = True
End Sub
Hai capito bene, assegno il nome foglio direttamente mentre li genero; ma questa e' l'unica variante, il resto e' di Friedrich.grazie anche a te Anthony, se ho capito bene, le modifiche che hai apportato, rinominano i fogli di volta in volta, giusto?
perfetta anche la tua
ActiveSheet.Name = "Step_" & Format(i + 1, "00")
ActiveSheet.Name = Format(Now + i, "dd-mm-yyyy") 'MMM
i = i +1
ActiveSheet.Name = "Step_" & Format(date () + 1, "00")
ActiveSheet.Range("A:P" & UltimaRiga).AutoFilter Field:=9, Criteria1:="MAIL"
Sub Copia_Mille_Righe()
Dim MieRighe As Long, GruppiRighe As Long, UltimaRiga As Long, i As Integer, NomeFoglio As String
'
MieRighe = 1000
'
' ========================== PEZZO AGGIUNTO
ActiveWindow.ScrollColumn = 2
Selection.AutoFilter
ActiveSheet.Range("A:P" & UltimaRiga).AutoFilter Field:=9, Criteria1:="MAIL"
Cells.Select
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Application.CutCopyMode = False
Selection.AutoFilter
ActiveSheet.Name = "MAIL"
'=================================
Application.ScreenUpdating = False
With ActiveSheet
UltimaRiga = .Range("A" & .Rows.Count).End(xlUp).Row
For GruppiRighe = 2 To UltimaRiga Step MieRighe
Sheets.Add After:=ActiveSheet
.Range("A" & GruppiRighe).Resize(MieRighe).EntireRow.Copy Range("A1")
Columns.AutoFit
'ActiveSheet.Name = "Step_" & Format(i + 1, "00") 'MMM
ActiveSheet.Name = Format(Now + i, "dd-mm-yyyy")
i = i + 1 'MMM
Next GruppiRighe
.Activate
End With
Application.ScreenUpdating = True
End Sub
UltimaRiga = .Range("A" & .Rows.Count).End(xlUp).Row
UltimaRiga = Range("A" & Rows.Count).End(xlUp).Row
Torna a Applicazioni Office Windows
copia di dati da un file chiuso e elaborazione Autore: luca62 |
Forum: Applicazioni Office Windows Risposte: 2 |
Aggiungere e eliminare righe senza alterare i riferimenti de Autore: trittico69 |
Forum: Applicazioni Office Windows Risposte: 4 |
cancella righe completamente vuote Autore: trittico69 |
Forum: Applicazioni Office Windows Risposte: 3 |
Input box range di celle di destinazione variabile Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 17 |
Problema con copia dati senza formattazione Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 9 |
Visitano il forum: Nessuno e 16 ospiti