excluir linhas tabela sem apagar formula macro vba

[BernardorValle]

Olá,

estou automatizando um planilha e me deparei com uma rotina que não consigo fazer funcionar direito.

 

Preciso que por macro, limpe exclua todas as linhas de uma tabela, mas sem apagar as formulas. Assim na próxima vez que for inserir dados na tabela, nos campos que contenham fórmula sejam automaticos.

 

O nome da tabela é TabelaABC.

 

Comando bem simples, mas não estou tendo sucesso.

[André_Arruda]

BernardorValle, Bom dia!

 

Você poderia considerar em jogar sua fórmula para o VBA também. 

Assim não precisa se preocupar com o conteúdo de suas células. 

 

No caso abaixo estou fazendo a fórmula =SOMA(A1:B8) dentro do VBA:

 

Aapplication.Worksheetfunction.Sum(range("A1:B8"))

 

Se puder, poste sua planilha que eu posso te ajudar melhor..

 

 

Abrç!

[BernardorValle]

3 minutos atrás, André_Arruda disse:

BernardorValle, Bom dia!

 

Você poderia considerar em jogar sua fórmula para o VBA também. 

Assim não precisa se preocupar com o conteúdo de suas células. 

 

No caso abaixo estou fazendo a fórmula =SOMA(A1:B8) dentro do VBA:

 

Aapplication.Worksheetfunction.Sum(range("A1:B8"))

 

Se puder, poste sua planilha que eu posso te ajudar melhor..

 

 

Abrç!

No caso é uma planilha de trabalho que faço análises caso a caso.

 

Para cada caso eu tenho que praticamente resetar a planilha, que consiste em apagar os dados de algumas tabelas.

 

Quero que essa rotina de zerar a planilha seja automática (para que cada vez que for fazer um cenário, não precise excluir manualmente).

 

Quando executo o comando pelo gravar, grava um macro que não serve (pois cada vez que insiro dados na planilha o número de linhas é diferente), mas segue o vba que grava quando executo o que precisamente quero

 

Sub ExcluirLinhatabela()
'
' ExcluirLinhatabela Macro
'

'
    range("TabelaABC").Select
    Selection.ListObject.ListRows(1).Delete
    Selection.ListObject.ListRows(1).Delete
    Selection.ListObject.ListRows(1).Delete
    Selection.ListObject.ListRows(1).Delete
    Selection.ListObject.ListRows(1).Delete
    Selection.ListObject.ListRows(1).Delete
    Selection.ListObject.ListRows(1).Delete
    Selection.ListObject.ListRows(1).Delete
    Selection.ListObject.ListRows(1).Delete
End Sub

 

No caso só funcionaria se a próxima vez que for excluir, tiver o mesmo número de linhas.

Mas não conheco comando que faça isso automático, sou novo com vba

[André_Arruda]

@BernardorValle Tente isso:

 

Sub ApagarValores()
  On Error Resume Next
    Range("F:F").SpecialCells(xlCellTypeConstants).ClearContents
  On Error GoTo 0
End Sub

 

Nesse caso estou considerando apenas a coluna "F" mas aí você altera para o intervalo da sua tabela.

 

 

Abrç!

[BernardorValle]

14 minutos atrás, André_Arruda disse:

@BernardorValle Tente isso:

 

Sub ApagarValores()
  On Error Resume Next
    Range("F:F").SpecialCells(xlCellTypeConstants).ClearContents
  On Error GoTo 0
End Sub

 

Nesse caso estou considerando apenas a coluna "F" mas aí você altera para o intervalo da sua tabela.

 

 

Abrç!

Funcionou sim, mas alterei um pouco

Sub ApagarValores()

lastrow = range("A" & Rows.Count).End(xlUp).Row
  On Error Resume Next
    range("A6:Y" & lastrow).SpecialCells(xlCellTypeConstants).ClearContents
  On Error GoTo 0
End Sub

 

Mas ainda não excluir as linhas, a tabela fica limpa mas com todas as linhas,

é possível escluir todas as linhas e ficar só uma? Assim a planilha fica mais leve

 

[André_Arruda]

Tente:

Sub ApagarValores()
  On Error Resume Next
    Range("F:F").SpecialCells(xlCellTypeConstants).ClearContents

    Range("F1:F10").EntireRow.delete

  On Error GoTo 0
End Sub

 

mudando F para o seu intervalo..

[BernardorValle]

19 minutos atrás, André_Arruda disse:

Tente:

Sub ApagarValores()
  On Error Resume Next
    Range("F:F").SpecialCells(xlCellTypeConstants).ClearContents

    Range("F1:F10").EntireRow.delete

  On Error GoTo 0
End Sub

 

mudando F para o seu intervalo..

Funcionou sim, muito obrigado.

 

Infelizmente notei que a rotina está bem pesada, mas o macro final funcionou. Se tiver alguma dica de como simplifica-lo segue o VBA

Sub aFormatABCConsolidado()

Application.ScreenUpdating = False

Dim w               As Worksheet
Dim wNew            As Workbook
Dim ArqparAbrir     As Variant
Dim A               As Integer
Dim NomeArquivo     As String


'rotina de limpar tabela ABC

Worksheets("CURVA ABC").Activate
lastrow = range("A" & Rows.Count).End(xlUp).Row
  On Error Resume Next
    range("A6:Y" & lastrow).SpecialCells(xlCellTypeConstants).ClearContents
    range("A7:Y" & lastrow).EntireRow.Delete
  On Error GoTo 0

'Rotina de limpar aba ABc Consolidado
Worksheets("ABCConsolidado").Activate
range("A2").Select
    range(Selection, Selection.End(xlToRight)).Select
    range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents

ArqparAbrir = Application.GetOpenFilename("Arquivo do Excel (*.xls),*xl*", _
                title:="Escolha os Arquivos", _
                MultiSelect:=True)


    If Not IsArray(ArqparAbrir) Then

        If ArqparAbrir = "" Or ArqparAbrir = False Then

    
    MsgBox "Processo Abortado, Nenhum arquivo selecionado", vbOKOnly, "Processo Cancelado"
    
        Exit Sub
        
        End If
        
    End If

Set w = Sheets("ABCConsolidado")

w.Select

For A = LBound(ArqparAbrir) To UBound(ArqparAbrir)

    NomeArquivo = ArqparAbrir(A)

    Application.Workbooks.Open (NomeArquivo)
    Set wNew = ActiveWorkbook
    
    ActiveSheet.range("A2").Select
    ActiveCell.FormulaR1C1 = _
    "=MID(CELL(""nome.arquivo""),SEARCH(""["",CELL(""nome.arquivo""))+5,SEARCH(""]"",CELL(""nome.arquivo""))-SEARCH(""["",CELL(""nome.arquivo""))-9)"
    ActiveSheet.range("A2").Select
    ActiveSheet.range(Selection, Selection.End(xlDown)).Select
    Selection.FillDown
    ActiveSheet.range("A2").Select
    ActiveSheet.range(Selection, Selection.End(xlToRight)).Select
    ActiveSheet.range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
        
    Selection.Copy Destination:=w.Cells(w.Rows.Count, 1).End(xlUp).Offset(1, 0)
    
    
    Application.DisplayAlerts = False
    
            ActiveWorkbook.Close savechanges:=False
        
    Application.DisplayAlerts = True

    w.Cells(w.Rows.Count, 1).End(xlUp).Offset(0, 1).Select


Next A

ActiveSheet.range("A2").Select
Selection.End(xlDown).Select
range(Selection, Selection.End(xlUp)).Select
Selection.Value = Selection.FormulaR1C1

        Cells.Select
    With Selection
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
    End With


Application.ScreenUpdating = True

'lastrow2 = worksheet("CURVA ABC").range("A" & Rows.Count).End(xlUp).Row

range("A2:G2").Select
    range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Worksheets("CURVA ABC").Activate
    Sheets("CURVA ABC").Select
    range("C6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.FormulaR1C1 = "=codigo_cp"
    range("B7").Select

MsgBox "Processo Realizado com suceesso"

Worksheets("Sumário Mapa de Estoque").Activate


End Sub