Excel, como automatizar procedimento?

Question

Estou com um problema e preciso pedir a vossa ajuda.

Tenho duas Planilhas "Formulario" e "Dados". No Formulário registo diversos dados em várias linhas e pretendo que esses dados sejam transferidos e fiquem gravados para a Planilha "Dados". O problema é que a Plan1 é desenvolvida em linhas e a Plan2 é desenvolvida em colunas,

Ex.:  Plan1             Numero = B1                         Plan2          Numero = A2
(Formulario)              Nome = B2                      (Dados)            Nome = B2
                             Morada = B3                                            Morada = C2
                                ...      = B4                                                 ...   = D2

Normalmente faço isto pelo processo COPY / PASTE, mas já são  muitos registo e perco muito tempo neste processo.

Haveria hipotese de alguém me ajudar a criar uma rotima para automatizar este procedimento ?
Muito obrigado

 

Answer 1

Experimente Colar > Especial > Transpor para converter linhas em colunas e vice-versa.

abs!

Answer 2

Ola Paulo,
Essa informação até que resultou na medida em que já não preciso copiar célula a célula. Já facilita muito.

Mas o ideal seria uma rotina ou uma macro que permitisse gravar os elementos inseridos no formulário, na linha imediatamente livre abaixo dos registos já colocados.

De qualquer forma, Obrigado pela ajuda.
[]s  

Answer 3

Tente adequar à sua necessidade, mas basicamente é isto:


Sub CopiaDados()
Dim rngOrigem As Range
Dim rngDestino As Range
Dim intReg As Integer

On Error GoTo TrErr:

    'Informa celula inicial dos dados de origem
    Set rngOrigem = xlForm.Cells(2, 1)
   
    'Informa celula inicial de destino
    Set rngDestino = xldados.Cells(xldados.Cells(2, 2).CurrentRegion.Rows.Count + 1, 1)

    'Busca registros existentes para nao sobrepor
    Do While Not IsEmpty(rngDestino)
        Set rngDestino = rngDestino.Offset(1, 0)
    Loop
   
   
    'Faz lop nos dados de origem
    Do While Not IsEmpty(rngOrigem)
          
        'Busca informacoes do registro encontrado
        For intReg = 0 To rngOrigem.CurrentRegion.Rows.Count - 1
            'Cola dados no destino
            rngDestino.Offset(, intReg) = rngOrigem.Offset(intReg, 0)
        Next intReg
       
        'Incrementa celula de origem
        Set rngOrigem = rngOrigem.Offset(, 1)
        'Incrementa celula de destino
        Set rngDestino = rngDestino.Offset(1, 0)
    Loop

TrErr:
    MsgBox Err.Number & " - " & Err.Description
   
End Sub

Abs.,

 

---

ricardo santos - Obtendo a resposta,marque respondida. Facilite a busca de outros usuários.