none
Código VBA, Plan2(100) a Plan30(130) RRS feed

 > 

  • Pergunta

  • Question
    Entrar para Votar
    0
    Entrar para Votar

    Estou precisando muito da ajuda abaixo:

    Código VBA que copia "células" da "plan2 a plan30" para a plan1 (Renomeada para "RELATORIO")

    Especificação:

    Plan1 (Renomeda para "RELATORIO"), copiar para a a plan "RELATORIO" as "células"  somente se estiver preenchidas.

    Plan2 para RELATORIO

    Q4     para    B4

    D25   para    C4

    D11   para    D4

    D33   para    E4

    I33    para    F4

    B33   para    G4

    N33   para    H4

    Plan3 repete a sequencia acima até a plan30.

    Se alguém puder ajudar fico-lhe grato.

    quinta-feira, 19 de junho de 2014 19:11
    |

Respostas

  • Question
    Entrar para Votar
    0
    Entrar para Votar

    Mario, vê se é isso que você precisa

    Sub Preencher_relatorio()

Dim i As Integer

For i = 2 To 30

If (Sheets("Plan" & i).Range("q4").Value <> "") Then
Sheets("RELATORIO").Range("B4").End(xlToRight).Offset(0, 1).Value = Sheets("Plan" & i).Range("q4").Value
End If
If (Sheets("Plan" & i).Range("d25").Value <> "") Then
Sheets("RELATORIO").Range("C4").End(xlToRight).Offset(0, 1).Value = Sheets("Plan" & i).Range("d25").Value
End If
If (Sheets("Plan" & i).Range("d11").Value <> "") Then
Sheets("RELATORIO").Range("D4").End(xlToRight).Offset(0, 1).Value = Sheets("Plan" & i).Range("d11").Value
End If
If (Sheets("Plan" & i).Range("d33").Value <> "") Then
Sheets("RELATORIO").Range("E4").End(xlToRight).Offset(0, 1).Value = Sheets("Plan" & i).Range("d33").Value
End If
If (Sheets("Plan" & i).Range("i33").Value <> "") Then
Sheets("RELATORIO").Range("F4").End(xlToRight).Offset(0, 1).Value = Sheets("Plan" & i).Range("i33").Value
End If
If (Sheets("Plan" & i).Range("b33").Value <> "") Then
Sheets("RELATORIO").Range("G4").End(xlToRight).Offset(0, 1).Value = Sheets("Plan" & i).Range("b33").Value
End If
If (Sheets("Plan" & i).Range("n33").Value <> "") Then
Sheets("RELATORIO").Range("H4").End(xlToRight).Offset(0, 1).Value = Sheets("Plan" & i).Range("n33").Value
End If

Next i

End Sub

    quinta-feira, 19 de junho de 2014 23:29
    |