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

Wagner, bom dia!

Muito obrigado é isso mesmo que estava precisando!