Achar a primeira linha preenchida e selecionar células abaixo!

[lupalestina]

Boa tarde Galera,

Estou precisando de uma ajuda com programação VBA.
Tenho várias planilhas com mais de 15 mil linhas e preciso quebrar em bases de 500 linhas.
Tentei (sem sucesso) elaborar uma macro que fizesse esse processo, de achar a primeira célula preenchida, recortar 500 linhas abaixo e 8 colunas a direita e colar em uma nova planilha.
alguém consegue me ajudar com isso?

[Tov Elen Shau]

Colega

Bom dia

Sem ver sua planilha estamos sujeitos a alguns erros, mas veja se consegue algo com a rotina abaixo. Coloque a rotina abaixo em um módulo e não se esqueça de atribuir o nome da planilha onde estão seus dados, na opção Set ws = Sheets("Planilha1") '---------Nome da planilha onde estão os dados. Faça o teste em uma cópia da sua planilha.

Sub TransporValores()
'ROTINA PARA BUSCAR VALORES E TRANSPOR PARA UMA NOVA PLANILHA
Dim ws As Worksheet
Set ws = Sheets("Planilha1") '---------Nome da planilha onde estão os dados
ws.Select '----------------------------Seleciona Planilha
Range("A1").Select '------------------Coluna que busca saber se está vazia ou não
Ult = Range("A650000").End(xlUp).Row '-Ultima linha preenchida, busca se concentrarão até esta linha

'ROTINA PARA LOCALIZAR A PRIMEIRA LINHA PREENCHIDA
Do
If ActiveCell.Value = Empty Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell.Value <> Empty Or ActiveCell.Row >= Ult

'ROTINA PARA TRANSPOR PARA NOVA PLANILHA VALORES ENCONTRADOS
Do
If ActiveCell.Value <> Empty Then
i = ActiveCell.Row
x = i + 499
Range("A" & i & ":" & "I" & x).Select '---Seleciona 500 Linhas das colunas A e B
'Selection.Copy '-------------------------COPIA células selecionadas
Selection.Cut '--------------------------RECORTA células selecionadas
Sheets.Add After:=ActiveSheet '-----------Cria uma nova planilha
ActiveSheet.Paste
Range("A1").Select
Else
ActiveCell.Offset(1, 0).Select
End If
ws.Select
Range("A" & x + 1).Select

Loop Until ActiveCell.Row >= Ult
MsgBox "Processo concluido com sucesso!", vbInformation, "CONCLUIDO"

End Sub

'Atenciosamente
'Tov Elen Shau