Que era assim eu entendi, pois o objetivo e que se aprenda, e como não forneceu dados completos acreditei que poderia/saberia adaptar.
Veja se avança
Sub GerarSheets()
'declarei as variaveis
Dim Nome As String
Dim lin As Long, linFinal As Long, lin_aux As Long, rN As Long
'Inibe tela e algumas mensagens e melhora a performance da macro
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
'ativa planilha base
Sheets(1).Activate
'Determina a ultima linha com dados
linFinal = Range("A1048576").End(xlUp).Row
Cells(2, 1).Activate
Range("A2").Select
'laço para percorrer a base de dados
For lin = 2 To linFinal Step 10 'Aqui de dez em dez altere se necessario
'Inclui nova sheet
Sheets.Add After:=Sheets(Sheets.Count)
'Utiliza o valor de uma celula como nome da planilha ou outro parametro
Nome = lin - 1 'Worksheets(1).Cells(lin, 1).Value
ActiveSheet.Name = Nome
lin_aux = 2
Sheets(1).Activate
Range(Cells(1, 1), Cells(1, 9)).Copy 'Copia cabecalho range a1:I1 -- altere para sua range
Sheets(Nome).Activate
Cells(1, 1).PasteSpecial
'Copia range estipulada aqui vai de 10 em 10 -- altere para sua range
If lin + 9 <= linFinal Then
rN = lin + 9
Else
rN = linFinal
End If
Sheets(1).Activate
Range(Cells(lin, 1), Cells(rN, 9)).Copy
Sheets(Nome).Activate
Cells(lin_aux, 1).PasteSpecial
ActiveWindow.Zoom = 100
Columns("A:I").ColumnWidth = 13
Range("A2").Select
Sheets(1).Select
Next
Sheets(1).Select
Range("A2").Select
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.CutCopyMode = False
End With
'exibe mensagem ao final do processo
MsgBox "Fim do Processo", vbInformation + vbOKOnly, "Aviso de Sistema"
End Sub
Postado : 25/11/2014 10:27 am