Amigo mrocf, alteré algo, dime si está correcto.
Código:
Sub copia_primer_sem_New()
Application.ScreenUpdating = False
Dim rng As Range
ActiveSheet.AutoFilterMode = False
Set rng = [A2:D2]
If [A3] <> "" Then Set rng = Range("A2:D" & [A2].End(xlDown).Row)
With rng
.Offset(-1).Resize(1 + .Rows.Count).AutoFilter 1, 1
.Columns(1).Copy 'Columna A
Sheets(4).[A2].PasteSpecial Paste:=xlPasteValues 'Pega en la hoja4
.Offset(-1).Resize(1 + .Rows.Count).AutoFilter 1, 2
.Columns(3).Copy 'Columna C
Sheets(4).[b2].PasteSpecial Paste:=xlPasteValues 'Pega en la hoja4
.Offset(-1).Resize(1 + .Rows.Count).AutoFilter 1, 3
.Columns(4).Copy 'Columna D
Sheets(4).[c2].PasteSpecial Paste:=xlPasteValues 'Pega en la hoja4
End With
ActiveSheet.AutoFilterMode = False
Application.CutCopyMode = False 'desactiva la seleccion
Application.ScreenUpdating = True
End Sub
Así me copia todos los datos de las 3 columnas completas y me los pega en la hoja4, para luego yo mandar imprimir
Me funciona bien para lo que quiero pero, quisiera tu aprobacion