ovelha070,

Não acha melhor postar um exemplo em planilha para ficar mais fácil alguém do fórum lhe ajudar?

Att,

para facilitar a implementação da solução
o ideal seria vc postar uma planilha de exemplo
de como é
e de como vc quer que fique.

ovelha070,

Bom Dia!

Não entendi nada...!

Me desculpe, pois sou novo aqui HEHE'

Fiz um exemplo de como o Macro funciona.

- Na tabela "A" é Como a planilha chega para mim

- Logo após a execução do Macro ela distribui os numeros em várias colunas - Nesse caso eu que escolho em quantas linhas vou distribuir os números.

- O problema é que na transferência ele "Come" 3 numeros da sequencia, exemplo: 19 e 20 - 24,25,26,27,28,29,30 - 34,35...

Espero que me compreendam e me ajudem por favor.

Obrigado

https://drive.google.com/file/d/0BwMO_wt6UQulLURKRG1LTE9BOEU/edit?usp=sharing

Sub Dividir_Coluna()

s = InputBox("Digite quantas linhas deve ter cada coluna:", "Configuração", "20")

If (s <> "") Then
cO = 1: loi = 1
cD = 3: ldi = 1: ld = ldi
lt = Range(Cells(loi, cO), Cells(Cells(Rows.Count, cO).End(xlUp), cO)).Rows.Count
For lo = loi To lt + loi
Cells(ld, cD).Value2 = Cells(lo, cO).Value2
ld = ld + 1
If ld = s + ldi Then ld = ldi: cD = cD + 1
Next
End If
End Sub

Sub Dividir_Coluna()

s = InputBox("Digite quantas linhas deve ter cada coluna:", "Configuração", "20")

If (s <> "") Then
cO = 1: loi = 1
cD = 3: ldi = 1: ld = ldi
lt = Range(Cells(loi, cO), Cells(Cells(Rows.Count, cO).End(xlUp), cO)).Rows.Count
For lo = loi To lt + loi
Cells(ld, cD).Value2 = Cells(lo, cO).Value2
ld = ld + 1
If ld = s + ldi Then ld = ldi: cD = cD + 1
Next
End If
End Sub

É exatamente isso amigo, mas seria distribuido a partir da coluna "A", ou seja, a função é para cortar e colar nas demais colunas, apagando a original.

Já agradeço pela ajuda e força que está dando amigo, estou muito estressado tentando resolver isso e a chefe quer uma solução.

Sub Dividir_Coluna()

s = InputBox("Digite quantas linhas deve ter cada coluna:", "Configuração", "20")

If (s <> "") Then
cO = 1: loi = 1
cD = 1: ldi = 1: ld = ldi
lt = Range(Cells(loi, cO), Cells(Cells(Rows.Count, cO).End(xlUp), cO)).Rows.Count
For lo = loi To lt + loi
d = Cells(lo, cO).Value2
Cells(lo, cO).Value2 = ""
Cells(ld, cD).Value2 = d
ld = ld + 1
If ld = s + ldi Then ld = ldi: cD = cD + 1
Next
End If
End Sub

Sub Dividir_Coluna()

s = InputBox("Digite quantas linhas deve ter cada coluna:", "Configuração", "20")

If (s <> "") Then
cO = 1: loi = 1
cD = 1: ldi = 1: ld = ldi
lt = Range(Cells(loi, cO), Cells(Cells(Rows.Count, cO).End(xlUp), cO)).Rows.Count
For lo = loi To lt + loi
d = Cells(lo, cO).Value2
Cells(lo, cO).Value2 = ""
Cells(ld, cD).Value2 = d
ld = ld + 1
If ld = s + ldi Then ld = ldi: cD = cD + 1
Next
End If
End Sub

Muito Obrigado por compartilhar sua inteligência.

Espero poder retribuir esse grande favor, ajudando aqui no forum.

Obrigado!!!

Olha eu novamente Edcronos.

Fui aplicar aquele código na minha planilha de trabalho e deu erro.
Vou mandar a planilha que vem para mim para vc dar uma olhada.

Alegria de pobre dura pouco...hehehe

https://drive.google.com/file/d/0BwMO_w ... sp=sharing

meu e-mail: [email protected]

Sub Dividir_Coluna()
Dim cd As Long, d As Variant
s = InputBox("Digite quantas linhas deve ter cada coluna:", "Configuração", "20")

If (s <> "") Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
cd = 1: ld = 1
lf = Cells(Rows.Count, 1).End(xlUp).Row

For lo = 1 To lf
d = Cells(lo, 1).Value2
'Cells(lo, 1).Value2 = ""
Cells(ld, cd).Value2 = d
ld = ld + 1
If ld = s + 1 Then ld = 1: cd = cd + 1
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End If

End Sub

Sub Dividir_Coluna()
Dim cd As Long, d As Variant
s = InputBox("Digite quantas linhas deve ter cada coluna:", "Configuração", "20")

If (s <> "") Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
cd = 1: ld = 1
lf = Cells(Rows.Count, 1).End(xlUp).Row

For lo = 1 To lf
d = Cells(lo, 1).Value2
'Cells(lo, 1).Value2 = ""
Cells(ld, cd).Value2 = d
ld = ld + 1
If ld = s + 1 Then ld = 1: cd = cd + 1
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End If

End Sub

Eu coloquei esse código e na hora de digitar quantas linhas deve ter em cada coluna eu digitei 460. Aconteceu que ele dividiu somente até a linha 460 e ai parou, tentei alterar alguns atributos, mas sem sucesso.
coloquei aqui o exemplo do resultado que citei acima.

https://drive.google.com/file/d/0BwMO_wt6UQulaVA3RTdWNXVmbzQ/edit?usp=sharing

Já estou enchendo o saco, me desculpe, mas sou novo em VBA e Macros.

não parou
apenas não apagou as linhas do original

troque
'Cells(lo, 1).Value2 = ""
por
Cells(lo, 1).Value2 = ""

o ' do inicio não deixa executar a linha de comando

Nem acredito que era apenas isso kkkkk...
Que Deus continue abençoando sua vida mano!

Obrigado!!!