Boa tarde,

Veja se este código atende:

Sub Converter()
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim Vetor(17)
    
    Sheets("Original").Select
    j = 8
    For i = 1 To ActiveSheet.UsedRange.Rows.Count
        If IsNumeric(Cells(i, "B").Value) And Cells(i, "B").Value <> "" Then
            Cells(i, "B").Select
            Vetor(0) = ActiveCell.Value
            Vetor(1) = ActiveCell.Offset(0, 1).Value
            Vetor(2) = ActiveCell.Offset(1, 1).Value
            Vetor(3) = ActiveCell.Offset(0, 6).Value
            Vetor(4) = ActiveCell.Offset(1, 6).Value
            Vetor(5) = ActiveCell.Offset(0, 11).Value
            Vetor(6) = ActiveCell.Offset(0, 12).Value
            Vetor(7) = ActiveCell.Offset(1, 12).Value
            Vetor(8) = ActiveCell.Offset(0, 13).Value
            Vetor(9) = ActiveCell.Offset(1, 13).Value
            Vetor(10) = ActiveCell.Offset(0, 14).Value
            Vetor(11) = ActiveCell.Offset(0, 17).Value
            Vetor(12) = ActiveCell.Offset(0, 18).Value
            Vetor(13) = ActiveCell.Offset(0, 19).Value
            Vetor(14) = ActiveCell.Offset(0, 20).Value
            Vetor(15) = ActiveCell.Offset(0, 21).Value
            Vetor(16) = ActiveCell.Offset(0, 22).Value
            Vetor(17) = ActiveCell.Offset(1, 22).Value
            
            For k = 0 To 17
                Sheets("Convertida").Cells(j, k + 2).Value = Vetor(k)
            Next
            j = j + 1
        End If
    Next
End Sub

Abraço

Boa tarde amigo JValq,

Muito obrigado, este código arrebentou, perfeito, me poupou um bom tempo de trabalho manual, poius havia feito umas fórmulas mas tinha de excluir linhas e colunas.

Abraços!!!!

Calmidoro
Santo André - SP
[email protected]

JValq,

Se não for pedir muito, poderia explicar esse código?

Boa tarde,

Caro joseA, veja se o código comentado atende à sua solicitação.
Qualquer dúvida é só postar.

Sub Converter()
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim Vetor(17)
    
    'Seleciona a planilha onde estão os dados a serem transferidos
    Sheets("Original").Select
    
    'Linha inicial da planilha de destino dos dados ("Convertidas")
    j = 8
    
    'Laço para percorrer toda a planilha de Origem e verificar o que
    'deve ser transferido
    For i = 1 To ActiveSheet.UsedRange.Rows.Count
    
        'As linhas onde há dados a serem transferidos foram identificadas
        'por ter um valor numérico na coluna "B" e diferente de "" (branco).
        'Esta identificação foi feita a partir de análise de como os dados estão
        'distribuídos na planilha de origem.
        'Com base nisso nota-se que os demais dados estão distribuídos na mesma linha
        'ou na linha abaixo sem seguir uma sequencia regular, por esse motivo usei um vetor
        'e a função "Offset" para colocá-los em sequencia para a transferência.
        If IsNumeric(Cells(i, "B").Value) And Cells(i, "B").Value <> "" Then
        
            'Seleciona a célula que identifica o início dos dados
            Cells(i, "B").Select
            
            'Atribui os valores das células ao vetor com base na posição relativa à
            'célula da coluna "B" selecionada.
            Vetor(0) = ActiveCell.Value
            Vetor(1) = ActiveCell.Offset(0, 1).Value
            Vetor(2) = ActiveCell.Offset(1, 1).Value
            Vetor(3) = ActiveCell.Offset(0, 6).Value
            Vetor(4) = ActiveCell.Offset(1, 6).Value
            Vetor(5) = ActiveCell.Offset(0, 11).Value
            Vetor(6) = ActiveCell.Offset(0, 12).Value
            Vetor(7) = ActiveCell.Offset(1, 12).Value
            Vetor(8) = ActiveCell.Offset(0, 13).Value
            Vetor(9) = ActiveCell.Offset(1, 13).Value
            Vetor(10) = ActiveCell.Offset(0, 14).Value
            Vetor(11) = ActiveCell.Offset(0, 17).Value
            Vetor(12) = ActiveCell.Offset(0, 18).Value
            Vetor(13) = ActiveCell.Offset(0, 19).Value
            Vetor(14) = ActiveCell.Offset(0, 20).Value
            Vetor(15) = ActiveCell.Offset(0, 21).Value
            Vetor(16) = ActiveCell.Offset(0, 22).Value
            Vetor(17) = ActiveCell.Offset(1, 22).Value
            
            'Com os dados inseridos no vetor é só transferir para
            'a planilha de destino.
            'O "k + 2" se deve ao fato do vetor começar em 0 e a coluna
            'começar "B" que equivale a 2.
            For k = 0 To 17
                Sheets("Convertida").Cells(j, k + 2).Value = Vetor(k)
            Next
            
            'Incrementa o número da linha
            j = j + 1
        End If
    Next
End Sub

Abraço

Boa noite!!!

Caro JValq, me desculpe a maneira de falar mas, você é o que ...? algum MVP da microsoft....você deve saber tudo de excel!!!!!

Tenho grande curiosidade de saber qual foi os seus passos para checar tão longe assim....é muita habilidade pra um cara só....minha nossa!!!

Parabéns pelas suas respostas ..todas sem exceção é pura qualidade!!!..obrigado por compartilha seu conhecimento conosco nos fórum em que está presente.

Quando vejo que foi você quem respondeu ..já quero logo saber o que é..e não me decepciono ...Obrigado, pois não ajuda só quem precisa ajuda também quem quer muito aprender.
Junto com você temos também o Edson, Mauro, Bernado, Patropi..e mais uma rapaziada do auto nível de excel...Obrigado a todos!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Boa noite,

Obrigado pelas palavras, Alexandre!
Ainda tenho muito a aprender...
O que aprendi foi por meio de livros, ajuda do Excel e Internet, basicamente.
Sempre gostei de programação de computadores e, apesar de estar meio "enferrujado", já programei em linguagens como Delphi (Pascal), C, C++, R, VB6 e VB.NET entre outras.
Umas por causa da faculdade e outras por curiosidade.
O conhecimento de outras linguagens facilita o aprendizado em VBA, pois você já começa tendo conhecimento de lógica de programação, que é fundamental.
Para programar em VBA, também é importante conhecer os recursos do Excel, como objetos e funções.
Participar dos fóruns também ajuda a “desenferrujar”, pois se não praticar você acaba esquecendo...
Portanto o caminho é gostar, ter curiosidade, praticar, ler a respeito do assunto, utilizar a ajuda do Excel, procurar na internet, etc.
Espero ter matado um pouco da sua curiosidade.

Abraço

Bomo dia!!!

Mais uma vez obrigado!!!....agora sim matou minha curiosidade.
Também sou curioso e gosto de programar mas tenho muito que aprender...

...Valeu ..at+++

Boa noite.

Complentando o assunto do alexandre sou usuario de outro forum Info JValq me ajudou muito tanto ele quanto mauro,acho que 90% do que sei do excel foram eles que me ensinaram. Uma curiosidade, voce sabe todos esses codigos de cabeça? pois as respostas das perguntas sempre são imediatas.

Abraço.

Boa tarde,

A maioria das respostas sai de imediato.
Algumas exigem consulta à ajuda do Excel ou à internet.

Abraço