Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
RECORTAR LINHA E CO...
 
Notifications
Clear all

RECORTAR LINHA E COLAR EM LOCAL ESPECIFICO

 
2024 - VBA & Macros
Post Recente por luke002 7 anos atrás
3 Posts
2 Usuários
0 Reactions
862 Visualizações
RSS
 luke002
(@luke002)
Posts: 0
New Member
Topic starter
 

Bom dia

Dei uma olhada em topicos parecidos mais nao consegui ajustar ao que eu preciso.

Preciso de uma macro de classificacao basicamente a macro vai vascullhar a planilha ''TO DO'' que se inicia na linha 52 e vai procurar o status ''DONE'' quando achar esse status ela vai recortar a linha e colar na primeira linha em branco da planilha 2.

E outra macro ''TO DO'' que se inicia na linha 52 e vai procurar o status ''PROGRESS'' quando achar esse status ela vai recortar a linha e colar na primeira linha em branco da TABELA ''PROGRESS''

O print com a explicacao e a planilha estao em anexo e obrigado a quem puder ajudar.

 
Postado : 22/02/2018 4:52 pm
 srobles
(@srobles)
Posts: 0
New Member
 

luke002,

Adicione um novo módulo em sua pasta de trabalho e cole o que segue :
Declaração de variáveis

'Declaramos as variáveis
Dim linhaAtual As Long
Dim ultimaLinha As Long
Dim novaLinha As Long
Dim moveSelecao As Boolean

Rotina para validar TUDO de uma só vez

'Rotina para validar TUDO de uma só vez
Sub validarTUDO()
    'Selecionamos a aba TASKS
    With ThisWorkbook.Sheets("TASKS")
        .Activate
        'Definimos a linha inicial
        linhaAtual = 54
        'Definimos a ultima linha
        ultimaLinha = .Cells(65535, 1).End(xlUp).Row
        'Definimos o modo moverSelecao para FALSO
        moveSelecao = False
        
        'Selecionamos a linha inicial
        .Cells(linhaAtual, 1).Select
        
        'Enquanto a linha atual for menor / igual a ultima linha preenchida
        While linhaAtual <= ultimaLinha
            'Se o valor da celula na linha atual, na coluna STATUS
            'for igual a DONE
            If .Cells(linhaAtual, 12) = "DONE" Then
                'Selecionamos toda a linha
                .Cells(linhaAtual, 1).EntireRow.Select
                'Copiamos a seleção
                Selection.Copy
                'Habilitamos o modo moverSelecao
                moveSelecao = True
                
                'Selecionamos a aba DONE
                With ThisWorkbook.Sheets("DONE")
                    .Activate
                    'Definimos qual será a linha á ser utilizada
                    'que no caso é a primeira em branco
                    novaLinha = .Cells(65535, 1).End(xlUp).Row + 1
                    
                    'Selecionamos a linha na coluna A
                    .Cells(novaLinha, 1).Select
                    'Colamos a seleção
                    ActiveSheet.Paste
                    
                    'Ajustamos todas as colunas da planilha
                    .Cells.Select
                    Selection.EntireColumn.AutoFit
                End With
                
                
            End If
            
            'Se o valor da celula na linha atual, na coluna STATUS
            'for igual a PROGRESS
            If .Cells(linhaAtual, 12) = "PROGRESS" Then
                'Selecionamos toda a linha
                .Cells(linhaAtual, 1).EntireRow.Select
                'Copiamos a seleção
                Selection.Copy
                'Habilitamos o modo moverSelecao
                moveSelecao = True
                
                'Selecionamos a aba PROGRESS
                With ThisWorkbook.Sheets("PROGRESS")
                    .Activate
                    'Definimos qual será a linha á ser utilizada
                    'que no caso é a primeira em branco
                    novaLinha = .Cells(65535, 1).End(xlUp).Row + 1
                    
                    'Selecionamos a linha na coluna A
                    .Cells(novaLinha, 1).Select
                    'Colamos a seleção
                    ActiveSheet.Paste
                    
                    'Ajustamos todas as colunas da planilha
                    .Cells.Select
                    Selection.EntireColumn.AutoFit
                    
                End With

            End If
            
            'Se o modo moverSelecao estiver habilitado
            If moveSelecao = True Then
                'Selecionamos a aba TASKS
                With ThisWorkbook.Sheets("TASKS")
                    .Activate
                    'Deletamos toda a linha selecionada
                    ActiveCell.EntireRow.Delete
                    'Desabilitamos o modo de cópia do Excel
                    Application.CutCopyMode = False
                End With
                'Desabilitamos o modo moverSelecao
                moveSelecao = False
            End If
            'Incrementamos e passamos para a próxima linha
            linhaAtual = linhaAtual + 1
            'Selecionamos a próxima linha
            .Cells(linhaAtual, 1).Select
        Wend
        
        'Ao término, notificamos o usuário
        MsgBox "Validação TO DO realizada com sucesso!", vbInformation, "Validação TO DO"
    End With
End Sub

Rotina para validar apenas status DONE

'Rotina para validar apenas status DONE
Sub validarDONE()
    'Selecionamos a aba TASKS
    With ThisWorkbook.Sheets("TASKS")
        .Activate
        'Definimos a linha inicial
        linhaAtual = 54
        'Definimos a ultima linha
        ultimaLinha = .Cells(65535, 1).End(xlUp).Row
        'Definimos o modo moverSelecao para FALSO
        moveSelecao = False
        
        'Selecionamos a linha inicial
        .Cells(linhaAtual, 1).Select
        
        'Enquanto a linha atual for menor / igual a ultima linha preenchida
        While linhaAtual <= ultimaLinha
            'Se o valor da celula na linha atual, na coluna STATUS
            'for igual a DONE
            If .Cells(linhaAtual, 12) = "DONE" Then
                'Selecionamos toda a linha
                .Cells(linhaAtual, 1).EntireRow.Select
                'Copiamos a seleção
                Selection.Copy
                'Habilitamos o modo moverSelecao
                moveSelecao = True
                
                'Selecionamos a aba DONE
                With ThisWorkbook.Sheets("DONE")
                    .Activate
                    'Definimos qual será a linha á ser utilizada
                    'que no caso é a primeira em branco
                    novaLinha = .Cells(65535, 1).End(xlUp).Row + 1
                    
                    'Selecionamos a linha na coluna A
                    .Cells(novaLinha, 1).Select
                    'Colamos a seleção
                    ActiveSheet.Paste
                    
                    'Ajustamos todas as colunas da planilha
                    .Cells.Select
                    Selection.EntireColumn.AutoFit
                End With
                
                
            End If
            
            'Se o modo moverSelecao estiver habilitado
            If moveSelecao = True Then
                'Selecionamos a aba TASKS
                With ThisWorkbook.Sheets("TASKS")
                    .Activate
                    'Deletamos toda a linha selecionada
                    ActiveCell.EntireRow.Delete
                    'Desabilitamos o modo de cópia do Excel
                    Application.CutCopyMode = False
                End With
                'Desabilitamos o modo moverSelecao
                moveSelecao = False
            End If
            'Incrementamos e passamos para a próxima linha
            linhaAtual = linhaAtual + 1
            'Selecionamos a próxima linha
            .Cells(linhaAtual, 1).Select
        Wend
        
        'Ao término, notificamos o usuário
        MsgBox "Validação DONE realizada com sucesso!", vbInformation, "Validação DONE"
    End With
End Sub

Rotina para validar apenas status PROGRESS

'Rotina para validar apenas status PROGRESS
Sub validarPROGRESS()
    'Selecionamos a aba TASKS
    With ThisWorkbook.Sheets("TASKS")
        .Activate        
        'Definimos a linha inicial
        linhaAtual = 54
        'Definimos a ultima linha
        ultimaLinha = .Cells(65535, 1).End(xlUp).Row
        'Definimos o modo moverSelecao para FALSO
        moveSelecao = False
        
        'Selecionamos a linha inicial
        .Cells(linhaAtual, 1).Select
        
        'Enquanto a linha atual for menor / igual a ultima linha preenchida
        While linhaAtual <= ultimaLinha
            'Se o valor da celula na linha atual, na coluna STATUS
            'for igual a PROGRESS
            If .Cells(linhaAtual, 12) = "PROGRESS" Then
                'Selecionamos toda a linha
                .Cells(linhaAtual, 1).EntireRow.Select
                'Copiamos a seleção
                Selection.Copy
                'Habilitamos o modo moverSelecao
                moveSelecao = True
                
                'Selecionamos a aba PROGRESS
                With ThisWorkbook.Sheets("PROGRESS")
                    .Activate
                    'Definimos qual será a linha á ser utilizada
                    'que no caso é a primeira em branco
                    novaLinha = .Cells(65535, 1).End(xlUp).Row + 1
                    
                    'Selecionamos a linha na coluna A
                    .Cells(novaLinha, 1).Select
                    'Colamos a seleção
                    ActiveSheet.Paste
                    
                    'Ajustamos todas as colunas da planilha
                    .Cells.Select
                    Selection.EntireColumn.AutoFit
                    
                End With

            End If
            
            'Se o modo moverSelecao estiver habilitado
            If moveSelecao = True Then
                'Selecionamos a aba TASKS
                With ThisWorkbook.Sheets("TASKS")
                    .Activate
                    'Deletamos toda a linha selecionada
                    ActiveCell.EntireRow.Delete
                    'Desabilitamos o modo de cópia do Excel
                    Application.CutCopyMode = False
                End With
                'Desabilitamos o modo moverSelecao
                moveSelecao = False
            End If
            'Incrementamos e passamos para a próxima linha
            linhaAtual = linhaAtual + 1
            'Selecionamos a próxima linha
            .Cells(linhaAtual, 1).Select
        Wend
        
        'Ao término, notificamos o usuário
        MsgBox "Validação PROGRESS realizada com sucesso!", vbInformation, "Validação PROGRESS"
    End With
End Sub

Espero ter ajudado.

Abs

 
Postado : 22/02/2018 7:20 pm
 luke002
(@luke002)
Posts: 0
New Member
Topic starter
 

Boa tarde

Man ajudou demais o do codigo done funcionou perfeitamente... O progress nao reclassificou e eu percebi prq e prq nao tinha uma aba progress estava na mesma aba.

Criei a aba progress para ver se funcionava so que precisa ajustar as outras linhas e meu conhecimento e limitado. Muito obrigado pelas linhas de esclarecimento no codigo ajuda muito a entender o que fazer.

Ja abusando da sua boa vontade poderia me ajudar com o ajuste das informacoes na planilha. Ele vai fazer a mesma coisa que antes procurar o status done e progress e dividir nas abas correspondentes sendo na primeira linha em branco. muito obrigado pela sua ajuda

 
Postado : 22/02/2018 8:41 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico