Macro que desactive el filtro de una tabla
La macro que tengo inserta al final de la tabla dos filas y copia dos fila nuevas el tema es que si la tabla esta con algún filtro copia los datos debajo de los datos filtrados y eso hace que después queden en cualquier dato .
Explicarme como puedo enviar la planilla para acomodarla
1 Respuesta
Respuesta de Dante Amor
1
Envíame tu archivo con datos para realizar pruebas
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Luis Mario” y el título de esta pregunta.
Te anexo la macro
Sub Macro3()
'
' Macro3 Macro
'
' Acceso directo: CTRL+q
'
If Range("a2").Value = "" Then
res = MsgBox("No existe fecha : " & hoja & vbCr & _
" Quieres darla de alta", vbQuestion + vbYesNo, "")
If res = vbNo Then
Exit Sub
End If
If res = vbYes Then
Exit Sub
Range("a2").Select
ActiveCell.Offset(0, 0).Select
End If
End If
ActiveSheet.Range("$A$5:$E$13").AutoFilter Field:=1
ActiveSheet.Range("$A$5:$E$13").AutoFilter Field:=2
ActiveSheet.Range("$A$5:$E$13").AutoFilter Field:=3
ActiveSheet.Range("$A$5:$E$13").AutoFilter Field:=4
ActiveSheet.Range("$A$5:$E$13").AutoFilter Field:=5
Range("b2").Select
If ActiveCell.Offset(1, 0).Value = "" Then
Range("b2").Copy
Range("b3").Select
ActiveCell.PasteSpecial xlValues
Application.CutCopyMode = False
End If
Call macro6
'Act.Por.Dante Amor
Set h1 = Sheets("LIBRO DIARIO")
hoja = Sheets("LIBRO DIARIO").[C2].Value
existe = False
For Each h In Sheets
If LCase(h.Name) = LCase(hoja) Then
existe = True
Exit For
End If
Next
If existe = False Then
res = MsgBox("No existe la hoja : " & hoja & vbCr & _
" Quieres darla de alta", vbQuestion + vbYesNo, "ALTA HOJA")
If res = vbNo Then Exit Sub
Sheets("formato").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = hoja
End If
'
Application.Goto Sheets(Sheets("LIBRO DIARIO").[C2].Text).[C2]
Range("A2").Select
On Error Resume Next
ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Select
'werr = Err.Number
'If werr <> 0 Then
' ActiveSheet.Range("A1").Offset(1, 0).Select
'End If
'AcA COPIE LA PARTE NUEVA ----------------
h1.Range("A2:E2").Copy
ActiveCell.PasteSpecial xlValues
ActiveCell.PasteSpecial Paste:=xlPasteColumnWidths
Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Select
ActiveCell.EntireRow.Insert
'
'--------- Actualiza balance
If existe = False Then
Set h2 = Sheets("BALANCE")
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Range("A" & u) = hoja
h2.Range("B" & u) = Sheets(hoja).[F2]
End If
'----------- ACA REGRESA AL LIBRO --------------------------
Sheets("libro diario").Select
Range("A2").Select
Range("A2:E2"). ClearContents
Range("B3:C3"). ClearContents
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
