Notifications

Clear all

Macro para mover linhas com critérios

2024 - VBA & Macros

Post Recente por derley537 7 anos atrás

9 Posts

4 Usuários

0 Reactions

2,023 Visualizações

RSS

derley537

(@derley537)

Posts: 16

Active Member

Topic starter

Bom dia!
Ttenho uma planilha de tarefas, e preciso de uma macro que, quando a tarefa for concluída, a macro verifique a coluna "f', se estiver s de sim, ela verifica a coluna onde tem o responsável pela tarefa, e envia a linha para a respectiva planilha do responsável pela tarefa, exemplo tarefa do Jailton concluída, enviar para a planilha do mesmo são funcionários só.

Postado : 11/04/2018 8:57 am

klarc28

(@klarc28)

Posts: 971

Prominent Member

Option Explicit

Sub TRANSFERIR()


Dim LINHA As Long
Dim LINHA2 As Long

For LINHA = 3 To Plan1.UsedRange.Rows.Count

If UCase(Plan1.Range("F" & LINHA).Value) = "S" Then
LINHA2 = 3
While Sheets(Plan1.Range("B" & LINHA).Value).Range("B" & LINHA2).Value <> ""

LINHA2 = LINHA2 + 1
Wend

Sheets(Plan1.Range("B" & LINHA).Value).Range("B" & LINHA2).Value = Plan1.Range("B" & LINHA).Value
Sheets(Plan1.Range("B" & LINHA).Value).Range("C" & LINHA2).Value = Plan1.Range("C" & LINHA).Value
Sheets(Plan1.Range("B" & LINHA).Value).Range("D" & LINHA2).Value = Plan1.Range("D" & LINHA).Value
Sheets(Plan1.Range("B" & LINHA).Value).Range("E" & LINHA2).Value = Plan1.Range("E" & LINHA).Value
Sheets(Plan1.Range("B" & LINHA).Value).Range("F" & LINHA2).Value = Plan1.Range("F" & LINHA).Value
Sheets(Plan1.Range("B" & LINHA).Value).Range("G" & LINHA2).Value = Plan1.Range("G" & LINHA).Value
Sheets(Plan1.Range("B" & LINHA).Value).Range("H" & LINHA2).Value = Plan1.Range("H" & LINHA).Value
Sheets(Plan1.Range("B" & LINHA).Value).Range("I" & LINHA2).Value = Plan1.Range("I" & LINHA).Value


End If

Next LINHA

End Sub

Postado : 11/04/2018 9:03 am

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Bom dia Dirley

Como você é novato, para facilitar a tua participação, sugiro tomar conhecimento do conteúdo dos links abaixo:
viewtopic.php?f=7&t=16757
viewtopic.php?f=7&t=203
viewtopic.php?f=7&t=7903
viewtopic.php?f=7&t=3841
viewtopic.php?f=7&t=12600
viewtopic.php?f=7&t=3371

Editei a tua mensagem, pois não é permitido digitar todo texto em letras maiúsculas ( Na interne é considerado como grito)

[]s
Patropi - Moderador

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 11/04/2018 9:07 am

derley537

(@derley537)

Posts: 16

Active Member

Topic starter

poxa meu amigo ficou show, só um pequeno probleminha, é que a macro copia, e precisava que ela movesse sabe, tipo a tarefa qd concluída sair dali! muito grato pela força.

Postado : 11/04/2018 9:41 am

klarc28

(@klarc28)

Posts: 971

Prominent Member

Option Explicit

Sub TRANSFERIR()


Dim LINHA As Long
Dim LINHA2 As Long

For LINHA = 3 To Plan1.UsedRange.Rows.Count

If UCase(Plan1.Range("F" & LINHA).Value) = "S" Then
LINHA2 = 3
While Sheets(Plan1.Range("B" & LINHA).Value).Range("B" & LINHA2).Value <> ""

LINHA2 = LINHA2 + 1
Wend

Sheets(Plan1.Range("B" & LINHA).Value).Range("B" & LINHA2).Value = Plan1.Range("B" & LINHA).Value
Sheets(Plan1.Range("B" & LINHA).Value).Range("C" & LINHA2).Value = Plan1.Range("C" & LINHA).Value
Sheets(Plan1.Range("B" & LINHA).Value).Range("D" & LINHA2).Value = Plan1.Range("D" & LINHA).Value
Sheets(Plan1.Range("B" & LINHA).Value).Range("E" & LINHA2).Value = Plan1.Range("E" & LINHA).Value
Sheets(Plan1.Range("B" & LINHA).Value).Range("F" & LINHA2).Value = Plan1.Range("F" & LINHA).Value
Sheets(Plan1.Range("B" & LINHA).Value).Range("G" & LINHA2).Value = Plan1.Range("G" & LINHA).Value
Sheets(Plan1.Range("B" & LINHA).Value).Range("H" & LINHA2).Value = Plan1.Range("H" & LINHA).Value
Sheets(Plan1.Range("B" & LINHA).Value).Range("I" & LINHA2).Value = Plan1.Range("I" & LINHA).Value
Plan1.Range("B" & LINHA).ENTIREROW.DELETE

End If

Next LINHA

End Sub

Postado : 11/04/2018 11:11 am

derley537

(@derley537)

Posts: 16

Active Member

Topic starter

muito obrigado amigo vcs são feras, não querendo abusar, eu consigo mover e manter a mesma formatação?

Postado : 11/04/2018 12:06 pm

Wagner Morel

(@wagner-morel-vidal-nobre)

Posts: 0

Illustrious Member

derley537,

Boa tarde!

Pedimos, por gentileza, que nas suas respostas, não use citação completa das mensagens que lhe foram enviadas. Se for necessário, estritamente para o entendimento da sua mensagem, você deve usar pequenos trechos da mensagem como citação.

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 : 11/04/2018 1:13 pm

klarc28

(@klarc28)

Posts: 971

Prominent Member

Cinco dicas que foram muito úteis para mim:

1) Quando não sei fazer algo no VBA, vou ao menu EXIBIÇÃO >> MACROS >> GRAVAR MACRO
Faço o que eu quero aí volto ao menu EXIBIÇÃO >> MACROS >> PARAR GRAVAÇÃO
Aperto Alt + F11 e vejo como a macro fez aquilo. Tento entender e tento adaptar.

2) Quando vou criar um código e o resultado não está saindo como o esperado, entro no código e vou apertando F8 para executar passo a passo, aí vou passando o mouse sobre as variáveis para verificar se o valores delas estão corretos, já consertei milhares de códigos dessa forma.

3) Antes de executar o código, vou ao menu Depurar >> Compilar. Isso ajuda corrigir erros mais simples, como o nome de uma variável digitado errado.

4) Declaro todas as variáveis. Isso também evita erros.

5) Sempre uso o Option Explicit lá no início. Ele me obriga a declarar as variáveis.

Option Explicit

Sub TRANSFERIR()
    
    
    Dim LINHA As Long
    Dim LINHA2 As Long
    
    For LINHA = 3 To Plan1.UsedRange.Rows.Count
        
        If UCase(Plan1.Range("F" & LINHA).Value) = "S" Then
            LINHA2 = 3
            While Sheets(Plan1.Range("B" & LINHA).Value).Range("B" & LINHA2).Value <> ""
                
                LINHA2 = LINHA2 + 1
            Wend
            
            Sheets(Plan1.Range("B" & LINHA).Value).Range("B" & LINHA2).Value = Plan1.Range("B" & LINHA).Value
            Sheets(Plan1.Range("B" & LINHA).Value).Range("C" & LINHA2).Value = Plan1.Range("C" & LINHA).Value
            Sheets(Plan1.Range("B" & LINHA).Value).Range("D" & LINHA2).Value = Plan1.Range("D" & LINHA).Value
            Sheets(Plan1.Range("B" & LINHA).Value).Range("E" & LINHA2).Value = Plan1.Range("E" & LINHA).Value
            Sheets(Plan1.Range("B" & LINHA).Value).Range("F" & LINHA2).Value = Plan1.Range("F" & LINHA).Value
            Sheets(Plan1.Range("B" & LINHA).Value).Range("G" & LINHA2).Value = Plan1.Range("G" & LINHA).Value
            Sheets(Plan1.Range("B" & LINHA).Value).Range("H" & LINHA2).Value = Plan1.Range("H" & LINHA).Value
            Sheets(Plan1.Range("B" & LINHA).Value).Range("I" & LINHA2).Value = Plan1.Range("I" & LINHA).Value
            Plan1.Range("B" & LINHA).EntireRow.Delete
            
            Sheets(Plan1.Range("B" & LINHA).Value).Range("A" & LINHA2 & ":I" & LINHA2).Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            Range("A" & LINHA2).Select
            
        End If
        
    Next LINHA
    
End Sub

Postado : 12/04/2018 3:25 am