Este fórum está sendo desativado

[anacletotranstusa]

Bom dia,
Todo mês preciso tirar um relatório do sistema, este relatório apresenta um serie de quebra de pagina contente títulos e cabeçalhos, a formatação atualmente é realizada manualmente perdendo muito. Preciso criar um rotina para exclusão de linhas e colunas por critérios.
O Layout que preciso deixar formatado seria:
Um único cabeçalho exemplo:
Código Linha, Tipo do Dia, Tabela, Jornada, Hora Chegada, Hora, Ponto, Apelido, Sentido Código Origem, Linha Origem Equipamento. Abaixo desse cabeçalho, preciso de todas as informações sequencias sem as quebras de paginas entre outros títulos e cabeçalhos. Feito isso posso realizar várias analise como filtro entre outras formulas.
Desde já agradeço atenção.

[alexandrevba]

Bom dia!!

Já tentou gravar uma Macro?

Código: Selecionar todos

Sub Macro1()
'
' Macro1 Macro
'

'
    Rows("1:5").Select
    Selection.Delete Shift:=xlUp
    Cells.Select
    ActiveWorkbook.Worksheets("Linhas").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Linhas").Sort.SortFields.Add Key:=Range( _
        "A2:A20702"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Linhas").Sort
        .SetRange Range("A1:AB20702")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A$1:$AB$20702").RemoveDuplicates Columns:=1, Header:= _
        xlYes
    Rows("2:4").Select
    Selection.Delete Shift:=xlUp
    Range("B5").Select
End Sub

Att

[anacletotranstusa]

Bom dia Alexandre,
Já tentei gravar uma macro sim, mas não tive sucesso. Sua macro também não obtive exito, preciso excluir somente os textos de cabeçalho e podares, as informações contidas em cada pagina preciso que sejam mantidas uma em baixo da outro. Sua macro, exclui várias informações que preciso que sejam mantidas. Se puder me auxiliar novamente.

Desde já agradeço sua atenção.

[alexandrevba]

Bom dia!!

Tente adaptar.

Código: Selecionar todos

Sub Macro1ssss()
Dim lastRow As Long
lastRow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Application.ScreenUpdating = 0
    Rows("1:5").Select
    Selection.Delete Shift:=xlUp
    Cells.Select
    ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Add Key:=Range("A2:A20702" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Plan1").Sort
        .SetRange Range("A1:P" & lastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("C:C,F:F, N:N").Select
    Range("F1").Activate
    Selection.Delete Shift:=xlToLeft
    [N1].Value = "AleVBA"
    With Range("N2:N50000")
        .Formula = "=IF(OR(A2=""Código"",LEFT(A2,8)=""Horários"",LEFT(A2,7)=""Página:"",LEFT(A2,4)=""Rese""),1,0)"
        .Value = .Value
    End With
    If WorksheetFunction.CountIf(Range("N2:N" & lastRow), "=1") > 0 Then
        Range("A1:N" & lastRow).AutoFilter Field:=14, Criteria1:="=1"
        Range("A2:N" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
    End If
    Columns("N:N").EntireColumn.Delete
    Cells.EntireColumn.AutoFit
    Application.ScreenUpdating = 1
End Sub

Cara: favor indicar sua postagem em outros foruns!!!!!!!
http://www.planilhando.com.br/forum/vie ... 5da#p89890

Att

[anacletotranstusa]

Boa Tarde Alexandre,
Peço desculpas! Sempre que postar algo estarei indicando no outro fórum!
Cara, tenho vário e vário relatório que exporto do sistema para o excel, tentei entender a lógica do código que por sinal ficou perfeito, porem não consegui entender. Teria como você me explicar a lógica para que possa estar implementando em outros relatórios (Colocando comentários em cada linha do código).
Se não for pedir de mais, digamos que eu teria a aba linhas e outra aba consulta, ao clicar no botão, transferisse as informações da aba linha para a aba Consulta e que na aba linhas permanecesse as informações conforme exportado do sistema.
Cara, muito obrigado mesmo pelo seus auxílios, sem palavrar para demonstrar minha gratidão.
Abraço!

[alexandrevba]

Boa tarde!!
Favor clicar na mãozinha!!!

Código: Selecionar todos

Option Explicit


Sub FavorClicarNaMaozinha()
Dim lastRow As Long
lastRow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row 'Conta a ultima linha com dados
Application.ScreenUpdating = 0
    Rows("1:5").Delete 'Deleta da linha 1 até a linha 5
    '%%%%%%%%%%%%%%%%%% Macro gravada %%%%%%%%%%%%%%%%%%
    Cells.Select
    ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Add Key:=Range("A2:A20702" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Plan1").Sort
        .SetRange Range("A1:P" & lastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    '%%%%%%%%%%%%%%%%%% Macro gravada %%%%%%%%%%%%%%%%%%
    Range("C:C,F:F, N:N").Delete 'Deleta as colunas C,F,N
    [N1].Value = "AleVBA"
    'Inseri uma formula na coluna N, para verificar as palavras chave que devem ser deletadas
    With Range("N2:N50000")
        .Formula = "=IF(OR(A2=""Código"",LEFT(A2,8)=""Horários"",LEFT(A2,7)=""Página:"",LEFT(A2,4)=""Rese""),1,0)"
        .Value = .Value
    End With
    'Conta o resultado da formula filtra caso seja = 1 e deleta essas linas
    If WorksheetFunction.CountIf(Range("N2:N" & lastRow), "=1") > 0 Then
        Range("A1:N" & lastRow).AutoFilter Field:=14, Criteria1:="=1"
        Range("A2:N" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
    End If
    With ActiveSheet
        .Columns("N:N").EntireColumn.Delete 'Retira a coluna com formula
        .AutoFilterMode = False 'Remove o filtro
        .Cells.EntireColumn.AutoFit 'Ajusta o tamanho das colunas
        .Range("A2", Range("M" & Rows.Count).End(xlUp)).Copy Worksheets("Consulta ").Range("A65536").End(xlUp)(2) 'Copia da guia ativa para guia Consulta
    End With
    Application.ScreenUpdating = 1
End Sub

Att

[anacletotranstusa]

Bom dia Alexandre,

Cara muito obrigado!
Peço desculpas, esqueci de clicar na mãozinha. Para um melhor entendimento, anexei o modelo que preciso . Vê se pode me ajudar.
Desde já agradeço sua atenção....

[alexandrevba]

Boa tarde!!

. Vê se pode me ajudar.

Eu não entendi..

Na postagem anterior você queria o código comentado, eu mandei!!

Você precisa de outro suporte em mais alguma coisa?

Att

[anacletotranstusa]

Boa Tarde Alexandre,
Perfeito! Seu código já atende minha necessidade. Gostaria de fazer uma alteração. No modelo anexo (poste anterior), na aba "LinhaRS1" seria as informações que exporto de um outro sistema, essas informações preciso mantelas conforme exportado e, ao clicar no botão organizar, transfere as informações organizadas para a aba consulta, mantendo sem alteração as informações da Aba "LinhaRS1".
Grato pela sua atenção.

[alexandrevba]

Boa tarde!!

Eu não entendi.

O código pega os dados de uma exportação e organiza depois copia para a guia Consulta!

o que vc precisa?

Att

[anacletotranstusa]

Boa Tarde Alexandre,
Preciso que os dados da exportação não seja organizado na aba "LinhaRS1", ou seja, que os dos permaneça como foi exportado, na aba Consulta preciso que os dados sejam copiados da aba "LinhaRS1! e organizados somente na aba Consulta. Digamos que faria uma copia dos dados exportados para a aba consulta e nela sim organizasse os dados, mantendo as informações retirada do sistema na aba "LinhasRS1".

[alexandrevba]

Boa tarde!!

Tente assim..

Código: Selecionar todos

Sub AleVBA_783V2()
Dim lastRow As Long
lastRow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row 'Conta a ultima linha com dados
Application.ScreenUpdating = 0

    Sheets("Consulta").Range("A:AZ").Delete
    Sheets("LinhasRS1").Cells.Copy
    Sheets("Consulta").Cells.PasteSpecial Paste:=xlValue
    Application.CutCopyMode = False

    Rows("1:5").Delete 'Deleta da linha 1 até a linha 5
    '%%%%%%%%%%%%%%%%%% Macro gravada %%%%%%%%%%%%%%%%%%
    Cells.Select
    ActiveWorkbook.Worksheets("Consulta").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Consulta").Sort.SortFields.Add Key:=Range("A2:A20702" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Consulta").Sort
        .SetRange Range("A1:P" & lastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    '%%%%%%%%%%%%%%%%%% Macro gravada %%%%%%%%%%%%%%%%%%
    Range("C:C,F:F, N:N").Delete 'Deleta as colunas C,F,N
    [N1].Value = "AleVBA"
    'Inseri uma formula na coluna N, para verificar as palavras chave que devem ser deletadas
    With Range("N2:N50000")
        .Formula = "=IF(OR(A2=""Código"",LEFT(A2,8)=""Horários"",LEFT(A2,7)=""Página:"",LEFT(A2,4)=""Rese""),1,0)"
        .Value = .Value
    End With
    'Conta o resultado da formula filtra caso seja = 1 e deleta essas linas
    If WorksheetFunction.CountIf(Range("N2:N" & lastRow), "=1") > 0 Then
        Range("A1:N" & lastRow).AutoFilter Field:=14, Criteria1:="=1"
        Range("A2:N" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
    End If
    With ActiveSheet
        .Columns("N:N").EntireColumn.Delete 'Retira a coluna com formula
        .AutoFilterMode = False 'Remove o filtro
        .Cells.EntireColumn.AutoFit 'Ajusta o tamanho das colunas
        .Range("A2", Range("M" & Rows.Count).End(xlUp)).Copy Worksheets("Consulta").Range("A65536").End(xlUp)(2) 'Copia da guia ativa para guia Consulta
    End With
    Application.ScreenUpdating = 1
End Sub

Att

[anacletotranstusa]

Bom dia Alexandre,
Quase isso! No exemplo anexo, inclui um botão com seu Código, ao clicar no botão, executo a macro e o botão sumiu, preciso que o potão fique aparecendo. As informações que forma transferida para a aba "Consulta", não ficaram organizadas como nos exemplos anteriores, preciso que fique organizada. As informações da aba "LinhasRS1, sem problemas pode ficar como está.
Preciso que o botão fica amostra, visto que a cada 3 meses irei fazer o mesmo procedimento visto que as informações sofrem atualizações no período. Muitas vezes não sou eu que faz essas atualizações, a outra pessoa não vai saber como ativar o botão.
Abraço.!

[alexandrevba]

Boa tarde!!

Quanto ao Botão, click no mesmo ou em um novo com o botão direito, Formtar controle -> Propriedades -> marque a opções Não mover ou dimencionar com células


Att

[anacletotranstusa]

Perfeito! Botão não some mais!
Percebi que os valores de horas se transformaram em números!!

[alexandrevba]

Boa tarde!!

Alguns dados quando transpostos pode ser alterador para o valor padrão de formatação da guia atual ou vice versa.

Selecione a coluna e volte ao formato que deseja (use o gravador de macro caso seja necessário).

Att