Copiar Datos de una tabla a un nuevo libro sin algunas columnas
Deseo copiar datos de un rango de fechas de una tabla a un nuevo archivo pero no se como crearlo ni como dejar de copiar algunas columnas, . Tengo este código mediante un botón y una formulario para escoger un rango de fechas a copiar.
Tengo este código que me copia el rango de fechas en otra hoja,(requiero un libro nuevo) por rango de fecha estoy tratando de ocultar columnas para que no las copie pero no me funciona.
Agradezco cualquier ayuda.
Private Sub Filtra_mes_Click()
'MsgBox ("Filtro desde " & Mes1 & "hasta " & Mes2)
Dim Fecha1 As Long, Fecha2 As Long
Fecha1 = Mes1
Fecha2 = Mes2
With ActiveSheet
If .AutoFilterMode = True Then .AutoFilterMode = False
End With
Range("j1").AutoFilter Field:=10, _
Criteria1:=">=" & Fecha1, Operator:=xlAnd, Criteria2:="<=" & Fecha2
Sheets("Hoja1").Range("E:E,F:F,G:G,I:I,K:K,R:R,S:S,V:V,W:W,Y:Y,Z:Z,AC:AC,AD:AD,AE:AE,AF:AF,AG:AG,AH:AL,AN:AN,AP:AP,AT:AW").Select
Range("Aw1").Activate
Selection.EntireColumn.Hidden = True
Columns("A:AX").Select
Selection.EntireColumn.Hidden = False
Range("a1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("INFORME").Cells(1, 1)
ActiveSheet.AutoFilterMode = False
Sheets("INFORME").Select
ActiveSheet.AutoFilterMode = False
Range("L1").Sort Key1:=Range("L2"), Order1:=xlAscending, _
Key2:=Range("X2"), Order2:=xlAscending, _
Key3:=Range("M2"), Order3:=xlAscending, Header:=xlYes
Unload Rango_Fecha
End Sub
2 Respuestas
Lo que pasa es lo siguiente:
Con esta línea ocultas las columnas:
Selection.EntireColumn.Hidden = True
Pero después seleccionas todas las columnas y las muestras con estas líneas:
Columns("A:AX").Select
Selection.EntireColumn.Hidden = FalseEntonces si borras esas líneas te copia solamente las celdas visibles.
Avísame cualquier duda. Si es lo que necesitas, no olvides valorar la respuesta.
si, es que sin querer copie mal, sería así: la pregunta es cómo hago para crear un libro nuevo
Private Sub Filtra_mes_Click()
'MsgBox ("Filtro desde " & Mes1 & "hasta " & Mes2)
Dim Fecha1 As Long, Fecha2 As Long
Fecha1 = Mes1
Fecha2 = Mes2
With ActiveSheet
If .AutoFilterMode = True Then .AutoFilterMode = False
End With
Range("j1").AutoFilter Field:=10, _
Criteria1:=">=" & Fecha1, Operator:=xlAnd, Criteria2:="<=" & Fecha2
Sheets("Hoja1").Range("E:E,F:F,G:G,I:I,K:K,R:R,S:S,V:V,W:W,Y:Y,Z:Z,AC:AC,AD:AD,AE:AE,AF:AF,AG:AG,AH:AL,AN:AN,AP:AP,AT:AW").Select
Range("Aw1").Activate
Selection.EntireColumn.Hidden = True
Range("a1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("INFORME").Cells(1, 1)
ActiveSheet.AutoFilterMode = False
Columns("A:AX").Select
Selection.EntireColumn.Hidden = False
Sheets("INFORME").Select
ActiveSheet.AutoFilterMode = False
Range("L1").Sort Key1:=Range("L2"), Order1:=xlAscending, _
Key2:=Range("X2"), Order2:=xlAscending, _
Key3:=Range("M2"), Order3:=xlAscending, Header:=xlYes
Unload Rango_Fecha
End Sub
Quedaría así:
Private Sub Filtra_mes_Click()
'MsgBox ("Filtro desde " & Mes1 & "hasta " & Mes2)
Dim Fecha1 As Long, Fecha2 As Long
'
Set l1 = ThisWorkbook
'
Fecha1 = Mes1
Fecha2 = Mes2
With ActiveSheet
If .AutoFilterMode = True Then .AutoFilterMode = False
End With
Range("j1").AutoFilter Field:=10, _
Criteria1:=">=" & Fecha1, Operator:=xlAnd, Criteria2:="<=" & Fecha2
Sheets("Hoja1").Range("E:E,F:F,G:G,I:I,K:K,R:R,S:S,V:V,W:W,Y:Y,Z:Z,AC:AC,AD:AD,AE:AE,AF:AF,AG:AG,AH:AL,AN:AN,AP:AP,AT:AW").Select
Range("Aw1").Activate
Selection.EntireColumn.Hidden = True
Range("a1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy 'Destination:=Sheets("INFORME").Cells(1, 1)
'
'Crear nuevo libro
Set l2 = Workbooks.Add
Set h2 = l2.Sheets(1)
h2.Range("A1").PasteSpecial xlAll
'
l1.Activate
ActiveSheet.AutoFilterMode = False
Columns("A:AX").Select
Selection.EntireColumn.Hidden = False
'
l2.Activate
'Sheets("INFORME").Select
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
Range("L1").Sort Key1:=Range("L2"), Order1:=xlAscending, _
Key2:=Range("X2"), Order2:=xlAscending, _
Key3:=Range("M2"), Order3:=xlAscending, Header:=xlYes
'
Unload Rango_Fecha
End Sub'.[ No olvides valorar la respuesta.
Esto te puede aportar algo más