Dim b_Export As Boolean Private Sub b_completar_Click() b_Export = False CopiarCeldas Unload Me End Sub Private Sub b_completar_exportar_Click() b_Export = True CopiarCeldas Unload Me End Sub Sub CopiarCeldas() Dim wsHoras As Worksheet, wsFdl As Worksheet Dim fechaDesde As Date, fechaHasta As Date Dim ultimaFilaConDatos As Long, ultimaFilaHoras As Long Dim i As Long, j As Long, k As Integer Dim respuesta As VbMsgBoxResult Dim nombreHojaHoras As String, nombreHojaFdl_1 As String, nombreHojaFdl_2 As String, nombreHojaFdl_3 As String, nombreHojaNota As String Dim pdfExportado As Boolean Const PrimeraFilaFDL = 17 ' Nombres de las hojas en variables estáticas nombreHojaHoras = "Horas" nombreHojaFdl_1 = "FDL_1" nombreHojaFdl_2 = "FDL_2" nombreHojaFdl_3 = "FDL_3" nombreHojaNota = "Nota" ' Establecer referencias a las hojas de trabajo Set wsHoras = ThisWorkbook.Sheets(nombreHojaHoras) Set wsFdl = ThisWorkbook.Sheets(nombreHojaFdl_1) ultimaFilaHoras = wsHoras.Cells(Rows.Count, 5).End(xlUp).Row ' Leer fechas desde los TextBox del formulario On Error Resume Next fechaDesde = GetDateFromForm(ConsultarFechas.t_desde.value) fechaHasta = GetDateFromForm(ConsultarFechas.t_hasta.value) ' Escribir el numero de factura ThisWorkbook.Sheets(nombreHojaNota).Cells(6, 3).value = ConsultarFechas.frm_factnro.value ' Validar que las fechas son correctas If IsEmpty(fechaDesde) Or IsEmpty(fechaHasta) Then MsgBox "Por favor, ingrese fechas válidas." Exit Sub End If On Error GoTo 0 ' Validar que las fechas son correctas If IsEmpty(fechaDesde) Or IsEmpty(fechaHasta) Then MsgBox "Por favor, ingrese fechas válidas." Exit Sub End If ' Comprobar que el rango de fechas no excede los 31 días If fechaHasta - fechaDesde > 31 Then MsgBox "El rango de fechas no puede exceder los 31 días." Exit Sub End If ' Preguntar al usuario si desea borrar el contenido selectivo de FDL_1 'respuesta = MsgBox("¿Desea borrar el contenido selectivo de la hoja FDL ?", vbYesNo) 'If respuesta = vbYes Then wsFdl.Range("A17:P44").ClearContents ThisWorkbook.Sheets(nombreHojaFdl_2).Range("A17:P44").ClearContents ThisWorkbook.Sheets(nombreHojaFdl_3).Range("A17:P44").ClearContents 'End If ' Iniciar variable para la fila de destino j = PrimeraFilaFDL ' Puesto que quieres empezar desde la fila 17 en FDL_1 k = 0 ' Recorrer cada fila en la hoja "Horas" For i = 3 To ultimaFilaHoras If CDate(wsHoras.Cells(i, 5).Value2) >= fechaDesde And CDate(wsHoras.Cells(i, 5).Value2) <= fechaHasta Then ' Copiar la celda a la hoja "FDL_1/2/3" wsFdl.Cells(j, 1).Value2 = wsHoras.Cells(i, 5).Value2 wsFdl.Cells(j, 3).value = Format(wsHoras.Cells(i, 6).value, "hh:mm") wsFdl.Cells(j, 4).value = wsHoras.Cells(i, 7).value wsFdl.Cells(j, 5).value = wsHoras.Cells(i, 8).value wsFdl.Cells(j, 6).value = wsHoras.Cells(i, 9).value If wsHoras.Cells(i, 14).value > 0 Then wsFdl.Cells(j, 7).value = wsHoras.Cells(i, 14).value If wsHoras.Cells(i, 15).value > 0 Then wsFdl.Cells(j, 8).value = wsHoras.Cells(i, 15).value wsFdl.Cells(j, 10).value = wsHoras.Cells(i, 2).value j = j + 2: k = k + 1 pdfExportado = False If k = 14 Then ExportarAsPDF wsFdl, Format(fechaDesde, "dd-MM"), Format(wsFdl.Cells(j - 2, 1).Value2, "dd-MM") Set wsFdl = ThisWorkbook.Sheets(nombreHojaFdl_2) j = PrimeraFilaFDL pdfExportado = True End If If k = 28 Then ExportarAsPDF wsFdl, Format(wsFdl.Cells(PrimeraFilaFDL, 1).Value2, "dd-MM"), Format(wsFdl.Cells(j - 2, 1).Value2, "dd-MM") Set wsFdl = ThisWorkbook.Sheets(nombreHojaFdl_3) j = PrimeraFilaFDL pdfExportado = True End If ' Si j supera 42, salir del bucle If k > 42 Then Exit For End If Next i If Not pdfExportado Then ExportarAsPDF wsFdl, Format(wsFdl.Cells(PrimeraFilaFDL, 1).Value2, "dd-MM"), Format(fechaHasta, "dd-MM") End If ' Exportar la factura ExportarAsPDF ThisWorkbook.Sheets(nombreHojaNota), "Fattura_" & Format(fechaDesde, "dd-MM"), Format(fechaHasta, "dd-MM") ' Exportar la factura ExportarAsPDF ThisWorkbook.Sheets("Foglio 1"), "Expenses_" & Format(fechaDesde, "dd-MM"), Format(fechaHasta, "dd-MM") ExportarAsXLS "Expenses_" & Format(fechaDesde, "dd-MM"), Format(fechaHasta, "dd-MM") ' Limpiar objetos Set wsFdl = Nothing End Sub Private Sub ExportarAsPDF(wsFdl As Worksheet, fechaDesde As String, fechaHasta As String) Dim rutaPDF As String Dim nombreArchivo As String If b_Export Then ' Construir el nombre del archivo PDF basado en las fechas nombreArchivo = "fdl_" & fechaDesde & " al " & fechaHasta & ".pdf" ' Mostrar el cuadro de diálogo "Guardar como" y obtener la ruta seleccionada rutaPDF = Application.GetSaveAsFilename(InitialFileName:=nombreArchivo, _ FileFilter:="PDF Files (*.pdf), *.pdf", Title:="Guardar como PDF") ' Comprobar si el usuario ha cancelado el cuadro de diálogo If (rutaPDF <> "False") And (rutaPDF <> "Falso") Then ' Exportar la hoja como PDF wsFdl.ExportAsFixedFormat Type:=xlTypePDF, Filename:=rutaPDF, _ Quality:=xlQualityStandard, IncludeDocProperties:=True, _ IgnorePrintAreas:=False, OpenAfterPublish:=False End If End If End Sub Private Sub ExportarAsXLS(fechaDesde As String, fechaHasta As String) Dim rutaPDF As String Dim nombreArchivo As String If b_Export Then ' Construir el nombre del archivo PDF basado en las fechas nombreArchivo = "fdl_" & fechaDesde & " al " & fechaHasta & ".xlsx" ' Mostrar el cuadro de diálogo "Guardar como" y obtener la ruta seleccionada rutaPDF = Application.GetSaveAsFilename(InitialFileName:=nombreArchivo, _ FileFilter:="XLS Files (*.xlsx), *.xlsx", Title:="Guardar como XLS") ' Comprobar si el usuario ha cancelado el cuadro de diálogo If (rutaPDF <> "False") And (rutaPDF <> "Falso") Then ' Exportar la hoja como PDF Dim Hoja1 As Worksheet, Hoja2 As Worksheet, Hoja3 As Worksheet, Hoja4 As Worksheet, Hoja5 As Worksheet Dim NuevoLibro As Workbook ' Ajusta los nombres de las hojas a los que necesitas Set Hoja1 = ThisWorkbook.Sheets("Nota") Set Hoja2 = ThisWorkbook.Sheets("FDL_1") Set Hoja3 = ThisWorkbook.Sheets("FDL_2") Set Hoja4 = ThisWorkbook.Sheets("FDL_3") Set Hoja5 = ThisWorkbook.Sheets("Foglio 1") ' Copia las hojas a un nuevo libro Hoja1.Copy Set NuevoLibro = ActiveWorkbook ' Con el nuevo libro activo, copia la segunda hoja Hoja2.Copy After:=NuevoLibro.Sheets(1) Hoja3.Copy After:=NuevoLibro.Sheets(2) Hoja4.Copy After:=NuevoLibro.Sheets(3) Hoja5.Copy After:=NuevoLibro.Sheets(4) ' Guarda el nuevo libro como archivo .xls ' Cambia la ruta de archivo y el nombre según necesites NuevoLibro.SaveAs rutaPDF, FileFormat:=xlWorkbookDefault ' Cierra el nuevo libro sin guardar cambios NuevoLibro.Close SaveChanges:=False End If End If End Sub Public Function GetDateFromForm(value As String) As Date Dim partesFecha() As String ' Leer fecha desde el TextBox t_desde partesFecha = Split(value, "/") On Error Resume Next GetDateFromForm = DateSerial(CInt(partesFecha(2)), CInt(partesFecha(1)), CInt(partesFecha(0))) On Error GoTo 0 End Function