Tentando formatar

2024 - VBA & Macros

Post Recente por edson751 9 anos atrás

3 Posts

2 Usuários

0 Reactions

539 Visualizações

RSS

edson751

(@edson751)

Posts: 2

New Member

Topic starter

Prezados,

mensalmente eu extraio um relatório do EBTA e tentei fazer uma macro para que formatasse de acordo com os requisitos, porém não está indo, podem me ajudar a achar o erro?

Sub Baseinfo()
'
' Baseinfo Macro
'
  While Range("A2").Value <> ""
    Range("A2").Select
    Selection.Cut
    Sheets("Plan2").Select
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Plan1").Select
    Range("A3").Select
    Selection.Cut
    Sheets("Plan2").Select
    Range("B2").Select
    ActiveSheet.Paste
    Sheets("Plan1").Select
    Range("A4").Select
    Selection.Cut
    Sheets("Plan2").Select
    Range("C2").Select
    ActiveSheet.Paste
    Range("A5").Select
    Selection.Cut
    Sheets("Plan2").Select
    Range("D2").Select
    ActiveSheet.Paste
    Range("A6").Select
    Selection.Cut
    Sheets("Plan2").Select
    Range("E2").Select
    ActiveSheet.Paste
    Range("A7").Select
    Selection.Cut
    Sheets("Plan2").Select
    Range("F2").Select
    ActiveSheet.Paste
    Range("A8").Select
    Selection.Cut
    Sheets("Plan2").Select
    Range("G2").Select
    ActiveSheet.Paste
    Range("A9").Select
    Selection.Cut
    Sheets("Plan2").Select
    Range("H2").Select
    ActiveSheet.Paste
    Range("A10").Select
    Selection.Cut
    Sheets("Plan2").Select
    Range("I2").Select
    ActiveSheet.Paste
    Range("A11").Select
    Selection.Cut
    Sheets("Plan2").Select
    Range("J2").Select
    ActiveSheet.Paste
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Sheets("Plan1").Select
    Range("A2:A11").Select
    Selection.Delete Shift:=xlUp
    Wend

End Sub

Postado : 23/11/2015 12:48 pm

Wagner Morel

(@wagner-morel-vidal-nobre)

Posts: 0

Illustrious Member

edson751

Boa Tarde!

Bem... não sei o que você estava querendo exatamente bem como o que você quis dizer com "porém não está indo". Entretanto, vi algumas coisas que não estavam adequadamente e alterei para que se comportem da mesma forma como o código iniciou. Veja se é assim:

Sub Baseinfo()
    '
    ' Baseinfo Macro
    '
    '
    
    While Range("A2").Value <> ""
        Range("A2").Select
        Selection.Cut
        Sheets("Plan2").Select
        Range("A2").Select
        ActiveSheet.Paste
        Sheets("Plan1").Select
        Range("A3").Select
        Selection.Cut
        Sheets("Plan2").Select
        Range("B2").Select
        ActiveSheet.Paste
        Sheets("Plan1").Select
        Range("A4").Select
        Selection.Cut
        Sheets("Plan2").Select
        Range("C2").Select
        ActiveSheet.Paste
        Sheets("Plan1").Select
        Range("A5").Select
        Selection.Cut
        Sheets("Plan2").Select
        Range("D2").Select
        ActiveSheet.Paste
        Sheets("Plan1").Select
        Range("A6").Select
        Selection.Cut
        Sheets("Plan2").Select
        Range("E2").Select
        ActiveSheet.Paste
        Sheets("Plan1").Select
        Range("A7").Select
        Selection.Cut
        Sheets("Plan2").Select
        Range("F2").Select
        ActiveSheet.Paste
        Sheets("Plan1").Select
        Range("A8").Select
        Selection.Cut
        Sheets("Plan2").Select
        Range("G2").Select
        ActiveSheet.Paste
        Sheets("Plan1").Select
        Range("A9").Select
        Selection.Cut
        Sheets("Plan2").Select
        Range("H2").Select
        ActiveSheet.Paste
        Sheets("Plan1").Select
        Range("A10").Select
        Selection.Cut
        Sheets("Plan2").Select
        Range("I2").Select
        ActiveSheet.Paste
        Sheets("Plan1").Select
        Range("A11").Select
        Selection.Cut
        Sheets("Plan2").Select
        Range("J2").Select
        ActiveSheet.Paste
        Rows("2:2").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Sheets("Plan1").Select
        Range("A2:A11").Select
        Selection.Delete Shift:=xlUp
    Wend
 End Sub

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

Postado : 23/11/2015 12:58 pm