miércoles, 2 de abril de 2014

VBA: SELECT CASE para distribuir datos entre hojas.

En más de una ocasión he expuesto usos de la instrucción SELECT CASE, y en esta ocasión (cuando las posibilidades de elección son altas), motivado por la pregunta de un lector, volveré a dar una explicación de cómo emplearlo:

Realice una Macro para un Formulario de introducción de datos Codigo-Nombre-Dirección-Telefono-Email y 5 hojas con los mismos campos.
El código se refiere a nombre de la calle de la dirección(BO-VE-FE-FR-BE) ese yo lo introduzco en el campo CODIGO, tengo 5 hojas con diferente nombre de calle (BONELLI-VENERE-FERRATO-FERRARI-BENEDETTI) y una con el nombre FORMULARIO donde se ingresan los datos, Necesito que al introducir los datos en este formulario se transfieran a la hoja correspondiente de acuerdo al código.


Esta vez se trata de dirigir datos registrados en una plantilla (una de nuestras hojas de cálculo llamada 'Formulario') hacia diferentes hojas del mismo libro, según corresponda al código introducido.

Veamos el asunto algo más claro. Tenemos una primera hoja con datos introducidos, en cuyo primer campo (columna A) aparecen ciertos códigos que corresponden a las hojas de color verde siguientes:

VBA: SELECT CASE para distribuir datos entre hojas.


En la imagen vemos, a modo de ejemplo, dos registros con dos códigos distintos FR y CO... lo que deberá llevarse a dos hojas distintas: FR a la hoja 'Ferrari' y BO a la hoja 'Bonelli'.

Para ello insertamos un módulo en nuestro proyecto VBA con el siguiente código:

Sub Traspaso()
Dim fila As Long, ultfila As Long
Dim rng As String

'recorremos los diferentes registros del Formulario
For Each celda In Range("TblDatos[Codigo]")
    fila = celda.Row
    rng = "A" & fila & ":" & "E" & fila
    Set origen = Sheets("Formulario").Range(rng)
    'identificamos la hoja destino, según 'Código'
    Select Case celda.Value
        Case "BO": Set destino = Sheets("Bonelli")
        Case "VE": Set destino = Sheets("Venere")
        Case "FE": Set destino = Sheets("Ferrato")
        Case "FR": Set destino = Sheets("Ferrari")
        Case "BE": Set destino = Sheets("Benedetti")
        Case Else: MsgBox "Código no válido": Exit Sub
    End Select

    'copiamos el registro a la hoja destino
    origen.Copy Destination:=destino.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Next celda
End Sub



A su vez, en la ventana del código asociado a la hoja 'Formulario', para automatizar el proceso 'Traspaso' incluimos un evento _Deactivate, para que al salir de la hoja 'formulario' realice el traspaso de información:

Private Sub Worksheet_Deactivate()
    Call Traspaso
End Sub



En este caso lo interesante no es el paso de copiado de registro, si no cómo identificamos el valor del 'Codigo' y mediante SELECT CASE los dirigimos a la hoja correcta, definiendo una variable con objeto... lo que facilita posteriormente su uso par el pegado en la hoja destino.

8 comentarios:

  1. Hola excelforo,
    Un placer saludarte, quisiera saber porque no copia dos o más código repetidos que solo me copia el último ( osea si tengo 3 Bonelli en la hoja formulario solo me copia el último Bonelli, deberia ser los tres Bonelli ).
    Gracias
    Arturo

    ResponderEliminar
    Respuestas
    1. Gracias Arturo...
      ha quedado corregido, se me coló al copiar unas pruebas.
      Slds

      Eliminar
  2. Muy buenos dias Ismael.

    cuando traspasa un registro y me devuelvo a la hoja formulario, vuelve y traspasa el mismo registro nuevamente. como puedo hacer para que lo traspase solo una vez pero que también sea automático porque si es llamando el procedimiento sub pues para lograr esto solo tendría que quitar el Private Sub Worksheet_Deactivate() . muchas gracias.

    ResponderEliminar
    Respuestas
    1. Hola José Francisco,
      en lugar de recorrer con
      For each
      todas las celdas del campo, podrías trasladar siempre la última fila registrada.. claro que corres el riesgo de dejar algún registro fuera.

      También podrías comprobar antes de copiar si el dato existe...

      Para automatizarlos, sin emplear el evento -Deactive, podrías asociar la misma macro a un procedimiento Sub en un Módulo, y luego ejecutar la macro en cuestión....

      Saludos

      Eliminar
  3. Cordial saludo,

    mira que al correr el programa me sale un error 1004 en la sgte fila

    For Each celda In Range("TblDatos[nombre]")

    me podrias colaborar gracias

    ResponderEliminar
    Respuestas
    1. Hola!
      Asegúrate que existe una Tabla llamada 'TblDatos' y un campo en ella 'nombre'
      Saludos

      Eliminar
  4. Hola buenos dias Ismael.

    Es que me pasa lo siguiente. Al correr la macro nuevamente me repite los registros que ya habian pasado anteriormente. Existe alguna froma que al correr la macro diariamente me sobreescriba todos los registros para que no me queden duplicados.
    Mil gracias

    ResponderEliminar
    Respuestas
    1. Hola Francisco,
      prueba cambiando la fila 21 del código:
      origen.Copy Destination:=destino.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
      por
      origen.Copy Destination:=destino.Range("A2")
      y no olvides eliminar los registros existentes en la hoja destino!!!
      Slds

      Eliminar