Código Macro:
Option Explicit
Sub Guardarventas()
Dim NombreHoja As String
Dim HojaDestino As Range
Dim NuevaFila As Integer
Dim FilasFactura As Integer
Dim i As Integer
Dim j As Integer
Dim NumFactura As String
Dim Ruta As String
Dim respuesta As VbMsgBoxResult
NombreHoja = "Ventas"
FilasFactura = Application.WorksheetFunction.CountA(Range("Ventas_1[Cód. Prod]"))
NumFactura = ThisWorkbook.Sheets("RegVentas").Range("C7").Value
'''''''''''''''''''''''''''''''''''''
If FilasFactura = 0 Or Range("valCliente").Value = "" Then _
MsgBox "Debes elegir un ciente e ingresar un código", vbExclamation, "ATENCIÓN": Exit Sub
' Preguntar si se desea imprimir la factura
respuesta = MsgBox("¿DESEA IMPRIMIRLA?", vbYesNo + vbQuestion, "DEZTACA")
If respuesta = vbYes Then
ActiveSheet.PrintOut
End If
'Propiedad FileDialog
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & " \ "
.Title = "ATENCIÓN - Seleccionar carpeta"
.Show
If .SelectedItems.Count = 0 Then
Else
Ruta = .SelectedItems(1)
MsgBox "Guardando en PDF Factura '" & NumFactura & "'. Presione Aceptar para continuar...", _
vbInformation, "DEZTACA"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Ruta & "\" & "Factura-" & NumFactura & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End If
End With
'''''''''''''''''''''''''''''''''''''
With ThisWorkbook.Sheets(NombreHoja)
For i = 1 To FilasFactura
Set HojaDestino = ThisWorkbook.Sheets(NombreHoja).Range("A1").CurrentRegion
NuevaFila = HojaDestino.Rows.Count + 1
.Cells(NuevaFila, 1).Value = Range("Date").Value
.Cells(NuevaFila, 2).Value = NumFactura
.Cells(NuevaFila, 3).Value = Range("valCliente").Value
.Cells(NuevaFila, 4).Value = Range("RIFCliente").Value
.Cells(NuevaFila, 12).Value = Range("TDOC").Value
.Cells(NuevaFila, 13).Value = Range("DivisaV").Value
.Cells(NuevaFila, 14).Value = Range("Fpago").Value
For j = 1 To 7
.Cells(NuevaFila, j + 4).Value = ThisWorkbook.Sheets("RegVentas").Cells(15 + i, 2 + j)
Next j
Next i
End With
Range("C8:C10").Select
Selection.ClearContents
Range("Ventas_1[Cód. Prod]").Select
Selection.ClearContents
Range("Ventas_1[REF. BUSCAR]").Select
Selection.ClearContents
Range("Ventas_1[Cant.]").Select
Selection.ClearContents
Range("g41").Select
Selection.ClearContents
MsgBox "Registro Exitoso"
End Sub