Este fórum está sendo desativado

[stefanordc]

Boa tarde!

Estou tentado criar um código VBA que recorte o telefone da coluna B, cole na coluna I e posteriormente exclua a linha que o telefone estava inserido.

Esta planilha é retirada da base de dados da minha empresa e a célula vem mesclada. Já criei um VBA que formata a planilha e a deixa exatamente como está o modelo em anexo.

Nem todas as planilhas são do tamanho do arquivo em anexo, então o ideal é criar um loop de repetição, porém o que estou fazendo está dando erro (segue o código abaixo).

Sub telefone()

Application.ScreenUpdating = False

linha = 3
linha_colar = 2

While Cells(linha, 2) <> ""
If Cells(linha, 2) <> "" Then
Cells(linha, 2).Select
Selection.Cut
If Cells(linha_colar, 9) = "" Then
Cells(linha_colar, 9).Select
ActiveSheet.Paste
End If
End If

linha = linha + 2
linha_colar = linha_colar + 2

Wend

Application.ScreenUpdating = True

End Sub

[JCabral]

Veja se resulta assim:

Código: Selecionar todos

Sub MovePhoneNumber()

    Dim StartLin As Long
    Dim iRow As Long
    
    Dim lRow As Long
    Dim WsD As Worksheet
    
    Set WsD = Worksheets("Planilha1")
    lRow = WsD.Cells(Rows.Count, 1).End(xlUp).Row \ 2 + 2
    
    StartLin = 3
    
    For iRow = StartLin To lRow
    
        WsD.Cells(iRow - 1, 9) = WsD.Cells(iRow, 2).Value
        WsD.Range(WsD.Cells(iRow, 1), WsD.Cells(iRow, 8)).Delete Shift:=xlUp
    Next iRow

    Set WsD = Nothing

End Sub

[stefanordc]

Deu certinho, JCabral. Muito obrigado!
Deu certinho, mano. Muito obrigado!

Veja se resulta assim:

Código: Selecionar todos

Sub MovePhoneNumber()

    Dim StartLin As Long
    Dim iRow As Long
    
    Dim lRow As Long
    Dim WsD As Worksheet
    
    Set WsD = Worksheets("Planilha1")
    lRow = WsD.Cells(Rows.Count, 1).End(xlUp).Row \ 2 + 2
    
    StartLin = 3
    
    For iRow = StartLin To lRow
    
        WsD.Cells(iRow - 1, 9) = WsD.Cells(iRow, 2).Value
        WsD.Range(WsD.Cells(iRow, 1), WsD.Cells(iRow, 8)).Delete Shift:=xlUp
    Next iRow

    Set WsD = Nothing

End Sub