Si tenemos nuestra documentación en forma de base de datos (facturación, cobranzas, documentos emitidos, etc), en algún momento necesitaremos enviar esa documentación a los destinatarios. O necesitaremos guardar en hojas separadas esa información.
En este ejemplo, parto de una lista de facturas emitidas y la idea es guardar esa información en formato de documento, por cada cliente de la lista.
Ejemplo 1: la lista no se encuentra filtrada. Se controla si el registro tiene saldo a facturar.
Sub facturando()
Dim hoC As Worksheet, hoF As
Worksheet
'se declaran las 2 hojas del
proceso
Set hoC =
Sheets("Clientes")
Set hoF =
Sheets("Formato")
'recorrer el rango a facturar
With hoC
For i = 4 To Range("B" & Rows.Count).End(xlUp).Row
'comprobar si tiene saldo <> 0
If .Range("X" & i) = 0
Then GoTo sigueOtro
'crear copia de la hoja Formato
agregándola al final
hoF.Copy After:=Sheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = .Range("D"
& i).Text
If Err.Number > 0 Then GoTo
existeHoja
sigo:
On Error GoTo 0
Set hoX = ActiveSheet
'pasar los datos a la nueva hoja
hoX.[D2] = .Range("D" &
i) 'nbre clie
hoX.[D3] = .Range("C" &
i) 'cod clie
hoX.[D4] = .Range("E" &
i) 'domicilio clie
hoX.[B6] = .Range("F" &
i) 'nro fact
hoX.[E6] = .Range("B" &
i) 'fecha
'evluar si hay valores en H o en I
If .Range("H" & i) = 0
Then
hoX.[E15] = .Range("I"
& i)
Else
hoX.[E15] = .Range("H"
& i)
End If
'concatenar col AA + AB
hoX.[A10] = .Range("AA" &
i) & " " & .Range("AB" & i)
hoX.[E16] = .Range("M" &
i) 'iva
hoX.[E17] = .Range("W" &
i) 'retencion
'se pasa a la fila siguiente de la
hoja base
sigueOtro:
Next i
End With
MsgBox "Fin del
proceso.", , "Información"
Exit Sub
existeHoja:
MsgBox "Ya existe una hoja de
nombre " & hoC.Range("D" & i).Text & Chr(10) & _
"El formato se guardará con
nombre de hoja " & ActiveSheet.Name & ".", vbCritical
GoTo sigo
End Sub
Ejemplo 2: Se aplicará filtro a la lista. Se recorre el rango rellenando el formato solo con datos de filas filtradas. Se controla si el registro tiene saldo a facturar.
Sub facturando_Filtrado()
'se declaran las 2 hojas del proceso
Set hoC = Sheets("Clientes")
Set hoF = Sheets("Formato")
'controles previos a la salida del formato (si se
aplicó filtro => si hay filas filtradas)
x = hoC.Range("B" &
Rows.Count).End(xlUp).Row
If x < 4 Then
MsgBox
"No hay datos para facturar.", , "Atención"
Exit Sub
End If
'recorrer el rango a facturar
With hoC
For Each
celdita In .Range("B4:B" & x).SpecialCells(xlCellTypeVisible)
'fila
de la celda visible
i = celdita.Row
'comprobar si tiene saldo <> 0
If .Range("X" & i) = 0 Then GoTo sigueOtro
'crear
copia de la hoja Formato agregándola al final
hoF.Copy After:=Sheets(Sheets.Count)
On
Error Resume Next
ActiveSheet.Name = .Range("D" & i).Text
If
Err.Number > 0 Then GoTo existeHoja
sigo:
On
Error GoTo 0
Set hoX
= ActiveSheet
'pasar
los datos a la nueva hoja
hoX.[D2] = .Range("D" & i)
hoX.[D3] = .Range("C" & i)
hoX.[D4] = .Range("E" & i)
hoX.[B6] = .Range("F" & i)
hoX.[E6] = .Range("B" & i)
If
.Range("E" & i) = 0 Then
hoX.[E15] = .Range("H" & i)
Else
hoX.[E15] = .Range("I" & i)
End If
hoX.[A10] = .Range("AA" & i) & " " &
.Range("AB" & i)
hoX.[E15] = .Range("B" & i)
hoX.[E16] = .Range("M" & i)
hoX.[E17] = .Range("W" & i)
sigueOtro:
Next celdita
End With
MsgBox "Fin del proceso.", ,
"Información"
Exit Sub
existeHoja:
MsgBox "Ya existe una hoja de nombre "
& hoC.Range("D" & i).Text & Chr(10) & _
"El formato se guardará con nombre de hoja
" & ActiveSheet.Name & ".", vbCritical
GoTo sigo
End Sub
Descargar libro con las macros desde aquí o solicitarlo al correo Gmail de: cibersoft.arg
Ver video Nº 78 desde aquí.
No hay comentarios.:
Publicar un comentario