Boa tarde!!

Além da pesquisa do fórum, cujo nela tem o que você deseja, use-a ou poste um arquivo modelo (compactado)!!!

Att

Olá Alexandre,

Já havia procurado, achei alguns exemplos semelhantes à estrutura que eu estou criando, porém, não consegui progredir. Vim então recorrer aos ninjas do MS Excel.

Estava tentando a princípio fazer a transferência do registro para base de dados com fórmulas, mas logicamente achei praticamente impossível (pra mim), não entendo muito de VBA, porisso que não consegui criar.

Segue modelo em anexo.

Se puder me ajudar ou dar uma luz, vai me ajudar bastante.

Abs,

Ricardo R. Alves

Boa tarde!!

Você precisa que os dados fiquem um embaixo do outro?
Use uma formula para capturar os campos (X6 até AU6), use a macro abaixo, se não conseguir retorne!!

Sub AleVBA_14677()
    Dim wsSrc As Worksheet
    Dim wsDst As Worksheet
     
    Set wsSrc = Worksheets("Novo")
    Set wsDst = Worksheets("Base de Dados")
     
    wsSrc.Range("X6:AU6").Copy
    wsDst.Range("A1").PasteSpecial xlPasteValues, Transpose:=False
    Application.CutCopyMode = False
    Columns.AutoFit
End Sub

Att

Consegui,

Obrigado Alexandre, estava quebrando a cabeça aqui.

Até mais,

Abs

Boa tarde!!

Veja meu modelo!!

Att

Boa tarde!!

Veja o código com um detalhe a mais (limpar os campos na guia NOVO)

Sub AleVBA_14677V2()
    Dim wsSrc As Worksheet
    Dim wsDst As Worksheet

    Set wsSrc = Worksheets("Novo")
    Set wsDst = Worksheets("Base de Dados")
    Application.ScreenUpdating = False
    With wsSrc
        .Range("Y6").FormulaR1C1 = "=R[25]C[-6]"
         .Range("Y7").FormulaR1C1 = "=RC[-21]"
          .Range("Y8").FormulaR1C1 = "=R[-1]C[-7]"
           .Range("Y9").FormulaR1C1 = "=R[1]C[-21]"
            .Range("Y10").FormulaR1C1 = "=RC[-13]"
             .Range("Y11").FormulaR1C1 = "=R[-1]C[-9]"
              .Range("Y12").FormulaR1C1 = "=R[-2]C[-6]"
               .Range("Y13").FormulaR1C1 = "=RC[-21]"
                .Range("Y14").FormulaR1C1 = "=R[-1]C[-14]"
        .Range("Y15").FormulaR1C1 = "=R[-2]C[-7]"
        .Range("Y16").FormulaR1C1 = "=R[1]C[-21]"
        .Range("Y17").FormulaR1C1 = "=RC[-7]"
        .Range("Y18").FormulaR1C1 = "=R[2]C[-21]"
        .Range("Y19").FormulaR1C1 = "=R[1]C[-13]"
        .Range("Y20").FormulaR1C1 = "=RC[-9]"
        .Range("Y21").FormulaR1C1 = "=R[-1]C[-6]"
        .Range("Y22").FormulaR1C1 = "=R[2]C[-21]"
              .Range("Y23").FormulaR1C1 = "=R[1]C[-10]"
             .Range("Y24").FormulaR1C1 = "=RC[-6]"
            .Range("Y25").FormulaR1C1 = "=R[2]C[-21]"
           .Range("Y26").FormulaR1C1 = "=R[1]C[-14]"
          .Range("Y27").FormulaR1C1 = "=RC[-10]"
         .Range("Y28").FormulaR1C1 = "=R[6]C[-6]"
        .Range("Y29").FormulaR1C1 = "=R[3]C[-21]"
    End With
    wsSrc.Range("Y6:Y29").Value = wsSrc.Range("Y6:Y29").Value
    
    Last_Row = Range("A" & Rows.Count).End(xlUp).Row
     With wsDst
        wsSrc.Range("Y6:Y29").Copy
        .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True
        .Columns.AutoFit
        wsSrc.Range("Y6:Y29").ClearContents
     End With
     Range("D7:N8,R7:V8,S10:V11,P10:P11,L10:N11,D10:I11,D13:G14,K13:O14,R13:V14,R17:V18,S20:V21,P20:P21,L20:N21,D20:I21,D17:M18,S24:T25,O24:P25,D24:L25,D27:G28,K27:L28,O27:P28,S31:V32,S34:V35,D32:O40").Select
     Selection.ClearContents
     Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub

Att

Hahahahaahahah!!!

Excelente!!!

A Macro faz tudo sozinha. =D

Obrigado Alexandre!

Forte Abraço.

Ricardo R. Alves

Boa tarde!!

Eu fico feliz que resolveu sua dúvida, obrigado pelo retorno!!

Att