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.

18 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
  5. Respuestas
    1. Hola
      que tal estás?, un placer saludarte igualmente

      Lo siento pero no hay fichero que descargar... solo replica los pasos... y si te surge alguna duda comentas

      Slds

      Eliminar
  6. Hola,

    tengo una planilla (RG-02) con diferentes datos distribuidos en 3 columnas de datos con 13 filas cada una. Lo que necesito es que se copien en otra planilla acumulativa (CARTA DE CONTROL - DATOS) estas 3 primeras columnas (serian las columnas 1,2,3) y cuando vuelva a ingresar datos a las columnas RG-02 estas se peguen a partir de la siguiente columna es decir columnas 4,5,6 y asi sucesivamente cada vez que ingrese datos a RG-02 se vayan acumulando. Gracias

    ResponderEliminar
    Respuestas
    1. Hola
      puedes detectar la última columna empleada en los procesos de copiado con lo que se explica en este otro post
      https://excelforo.blogspot.com/2017/03/vba-Localizar-Ultima-Fila-Excel.html

      Espero te sirva
      Slds

      Eliminar
    2. Gracias por su respuesta.

      Lo que necesito pero es copiar y pegar datos en las columnas de (CARTA DE CONTROL - DATOS), no asi solamente el detectar.
      El codigo que tengo actualmente me permite pegar las columnas en la hoja de "CARTA DE CONTROL - DATOS", pero si vuelvo a ingresar datos en celdas de origen me reemplazaran las ya rellenadas y lo que necesito es q se acumulen en la siguiente columna.
      Private Sub CommandButton1_Click()

      Range("Q11:Q23").Copy
      Worksheets("CARTA DE CONTROL - DATOS").Range("C16:C28").PasteSpecial xlPasteValues

      Application.CutCopyMode = False

      Range("Q35:Q47").Copy
      Worksheets("CARTA DE CONTROL - DATOS").Range("D16:D28").PasteSpecial xlPasteValues

      Application.CutCopyMode = False

      Range("Q59:Q71").Copy
      Worksheets("CARTA DE CONTROL - DATOS").Range("E16:E28").PasteSpecial xlPasteValues

      Application.CutCopyMode = False

      End Sub

      Gracias por su colaboracion

      Eliminar
    3. Hola,
      correcto...
      el proceso es el mismo:
      dim UC as long
      UC=.... 'aquí el código comentado
      Range("Q11:Q23").Copy
      Worksheets("CARTA DE CONTROL - DATOS").Cells(16,UC).PasteSpecial xlPasteValues

      Saludos

      Eliminar
    4. Me quedo el el codigo..
      Dim UC As Long

      UC = InputBox("Ingrese en numero de columna que corresponde rellenar")
      '3 = c
      '4 = d
      '5 = e .......

      If UC = 3 Then
      Worksheets("RG-02").Range("Q11:Q23").Copy
      Worksheets("CARTA DE CONTROL - DATOS").Cells(16, UC).PasteSpecial xlPasteValues
      End If

      If UC = 4 Then
      Worksheets("RG-02").Range("Q35:Q47").Copy
      Worksheets("CARTA DE CONTROL - DATOS").Cells(16, UC).PasteSpecial xlPasteValues
      End If

      If UC = 5 Then
      Worksheets("RG-02").Range("Q59:Q71").Copy
      Worksheets("CARTA DE CONTROL - DATOS").Cells(16, UC).PasteSpecial xlPasteValues
      End If
      .................

      Muchas Gracias ;-)

      Eliminar
    5. ;-)
      Igualmente se podría haber automatizado sin necesidad de interpelar al usuario con un INPUTBOX
      Saludos

      Eliminar
  7. Hola tengo una duda, existe alguna manera de poder copiar datos a otro archivo excel pero de la siguiente forma, tienes una base y abres otro, si los titulos de la columna coinciden los copia en otro archivo y asi lo va haciendo columna por columna y cuando termine el recorrido se cierre el archivo y el archivo al que copió los datos se guarde con un nombre, lo mismo vaya haciendo con mas archivos que va jalando de una carpeta y asi vaya creando mas archivos, me apoyan? vi que podian ser con case, pero cómo

    ResponderEliminar
    Respuestas
    1. Hola,
      sería posible empleando un bucle que recorra la carpeta que contenga los ficheros, luego que lo abra y nuevamente un bucle que recorra los encabezados buscando las columnas oportunas, para copiar y pegar/trasladar los datos... y finalmente cerrar el fichero abierto

      Esto es demasiado largo para incluirlo en un comentario ;-)
      Lee, por favor, las Normas de uso del blog

      Un cordial saludo

      Eliminar

Nota: solo los miembros de este blog pueden publicar comentarios.