Como pegar un rango en un libro nuevo seleccionando el rango por medio de CurrentRegion
Intento programar una macro que me jale el contenido de una hoja a un libro nuevo, seleccionando el rango por currentregion, pero al momento de pegarlo en el libro nuevo solo se trae la información de la celda A1, pego el código abajo para mayor referencia... Gracias de antemano!
Sub TXT_click()
Dim poliza As Variant
Range("F65000").End(xlUp).Offset(1, 0).Value = "Final"
Range("F1").Select
Do While ActiveCell.Value <> "Final"
If IsEmpty(ActiveCell) Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
ActiveCell.ClearContents
poliza = Sheets("Machote").Range("A1").CurrentRegion
Workbooks.Add
ActiveWorkbook.Sheets("Hoja1").Range("A1") = poliza
Sheets("Hoja1").Range("D:D").Delete
Sheets("Hoja1").Range("C1").Select
Selection.NumberFormat = "dd/mm/yyy"
ActiveWorkbook.SaveAs Filename:="C:\Users\Ec\Documents\luz\LayOut" & " " & Range("G1")
ActiveWorkbook.SaveAs Filename:="C:\Users\Ec\Documents\luz\Layout" & " " & Range("G1") & ".csv", FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook. Close (False)
Application. Workbooks("Viri2.xlsm").Worksheets("Machote").Range("A1").CurrentRegion.ClearContents
End Sub
Te anexo la macro con la actualización para copiar la información de una hoja al libro nuevo, supongo que lo demás de la macro funciona correctamente.
Sub TXT_click()
'Act.Por.Dante Amor
Range("F65000").End(xlUp).Offset(1, 0).Value = "Final"
Range("F1").Select
Do While ActiveCell.Value <> "Final"
If IsEmpty(ActiveCell) Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
ActiveCell. ClearContents
'
Sheets("Machote"). UsedRange. Copy
Workbooks. Add
ActiveSheet. Paste
ActiveSheet.Range("D:D").Delete
ActiveSheet.Range("C1").Select
Selection.NumberFormat = "dd/mm/yyy"
'
ActiveWorkbook.SaveAs Filename:="C:\Users\Ec\Documents\luz\LayOut" & " " & Range("G1")
ActiveWorkbook.SaveAs Filename:="C:\Users\Ec\Documents\luz\Layout" & " " & Range("G1") & ".csv", FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook. Close (False)
Application. Workbooks("Viri2.xlsm").Worksheets("Machote").Range("A1").CurrentRegion.ClearContents
End Sub
