
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ActiveSheet.Unprotect Password:="123"
Sheets("BASE").Activate
Sheets("BASE").Unprotect "123"
Sheets("VENTA").Select
filalibre = Sheets("BASE").Range("A1048576").End(xlUp).Row + 1
ActiveSheet.Range("A10").Select
Fila = 10
While ActiveCell.Value <> ""
Sheets("Base").Cells(filalibre, 3) = ActiveSheet.Range("F4")  'NRO FACT
Sheets("Base").Cells(filalibre, 1) = ActiveSheet.Range("B4")  'FECHA
Sheets("Base").Cells(filalibre, 4) = ActiveSheet.Range("C6")  'PROVEEDOR
'Sheets("Base").Cells(filalibre, 6) = ActiveSheet.Range("G4")  'N ESTADO
'Sheets("Base").Cells(filalibre, 7) = ActiveSheet.Range("F5")  'COD. CONT.
'Sheets("Base").Cells(filalibre, 19) = ActiveSheet.Range("J1")  'TIPO
'Sheets("Base").Cells(filalibre, 20) = ActiveSheet.Range("H1")  'MES

'otros datos del encabezado

'copiamos lista de items
Sheets("Base").Cells(filalibre, 11) = ActiveCell.Offset(0, 0) 'CANT
Sheets("Base").Cells(filalibre, 6) = ActiveCell.Offset(0, 1) 'COD PROD
'Sheets("Base").Cells(filalibre, 10) = ActiveCell.Offset(0, 3) 'DESCRIPC
Sheets("Base").Cells(filalibre, 9) = ActiveCell.Offset(0, 4) 'COSTO/PRECIO

'incremento la variable fila para repetir el bucle
filalibre = filalibre + 1

'repito el bucle para los items siguientes
ActiveCell.Offset(1, 0).Select
Wend
'una vez concluda la copia debiera limpiarse el form de datos
'para el ingreso de nueva factura


ActiveSheet.Protect Password:="123"
Sheets("Base").Activate
Sheets("Base").Protect "123"
Sheets("VENTA").Select
'ActiveWorkbook.Save
MsgBox "Tus Datos se Guardaron Corectamente"
Application.Calculation = xlCalculationAutomatic