MS Excel 2003: pruebe cada valor en la columna A y copie los valores coincidentes en el nuevo libro de trabajo

Los datos expuestos en este blog, son solo de índole informativo. Por favor realiza siempre una copia de seguridad antes de realizar cualquier cambio en tu proyecto.

MS Excel 2003: pruebe cada valor en la columna A y copie los valores coincidentes en el nuevo libro de trabajo

Este tutorial de Excel explica cómo escribir una macro para probar cada valor en una columna y copiar el valor coincidente en un nuevo libro de trabajo en Excel 2003 y versiones anteriores (con capturas de pantalla e instrucciones paso a paso).

Pregunta: En Microsoft Excel 2003/XP/2000/97, ¿cómo escribo una macro de Excel que necesita comparar los datos en la columna A y copiar los valores coincidentes en un nuevo libro de trabajo?

Entonces, si hay 100 filas en la hoja de trabajo y los datos en la columna A de las primeras 50 filas son iguales, pero A51 contiene valores diferentes y desea copiar los datos de A2 a A50 en el nuevo libro de trabajo.

Luego, la macro continuará comparando los valores en la columna A comenzando en la celda A51 hasta que se encuentre un valor diferente. Luego copia los datos en otro nuevo libro de trabajo, y así sucesivamente… hasta que se evalúan todos los valores en la columna A.

Respuesta: Debería poder crear una macro para probar cada valor en la columna A y buscar diferencias.

Veamos un ejemplo.

Descargue la hoja de cálculo de Excel (que se muestra a continuación)

En nuestra hoja de cálculo, creamos un botón llamado “Copiar datos” en la tabla de datos. Cuando el usuario hace clic en este botón, se ejecutará una macro llamada CopyData. Esta macro analizará cada valor en la columna A para buscar diferentes valores.

Cuando se encuentra un valor diferente en la columna A de la hoja de datos, la macro copia los valores de las columnas A a D en el valor diferente y lo pega en un nuevo libro de trabajo.

Entonces, en este ejemplo, copiará todas las filas hasta los valores de Microsoft en la celda A8 (en la hoja de datos) y pegará esos valores en un nuevo libro de trabajo.

Luego, la macro regresa a la columna A en la hoja de datos y continúa analizando los valores a partir de la celda A8.

Luego crea otro libro de trabajo y copia los datos de Microsoft en este nuevo libro de trabajo.

Cuando la macro esté completa, aparecerá el cuadro de mensaje anterior. Identifica cuántos libros nuevos se han creado y dónde encontrarlos.

Puede verlo seleccionando Nuevo libro de trabajo en el menú Ventana. En este ejemplo, creamos Book1 y Book2.

Book1 muestra datos de Tech on the Net.

Book2 muestra datos de Microsoft.

Puede presionar Alt+F11 para ver el código VBA.

codigo macro

El código de la macro se ve así:

Sub CopyData()

   Dim LMainWB As String
   Dim LNewWB As String
   Dim LRow As Integer
   Dim LContinue As Boolean
   Dim LColAMaster As String
   Dim LColATest As String
   Dim LWBCount As Integer
   Dim LMsg As String

   'Retrieve name of the workbook that contains the data
   LMainWB = ActiveWorkbook.Name

   'Initialize variables
   LContinue = True
   LRow = 2
   LWBCount = 0

   'Start comparing with cell A2
   LColAMaster = "A2"

   'Loop through all column A values until a blank cell is found
   While LContinue = True

      LRow = LRow + 1
      LColATest = "A" & CStr(LRow)

      'Found a blank cell, do not continue
      If Len(Range(LColATest).Value) = 0 Then
         LContinue = False
      End If

      'Found occurrence that did not match, copy data to new sheet
      If Range(LColAMaster).Value <> Range(LColATest).Value Then

         'Copy headings
         Range("A1:D1").Select
         Selection.Copy

         'Add new workbook and paste headings into new workbook
         Workbooks.Add
         LNewWB = ActiveWorkbook.Name
         ActiveSheet.Paste
         Range("A1").Select

         'Copy data from columns A - D
         Windows(LMainWB).Activate
         Range(LColAMaster & ":D" & CStr(LRow - 1)).Select
         Selection.Copy

         'Paste results
         Windows(LNewWB).Activate
         Range("A2").Select
         ActiveSheet.Paste
         Range("A1").Select

         'Go back to Main sheet and continue where left off
         Windows(LMainWB).Activate
         LColAMaster = "A" & CStr(LRow)

         'Keep track of the number of workbooks that have been created
         LWBCount = LWBCount + 1

      End If

   Wend

   Range("A1").Select
   Application.CutCopyMode = False

   LMsg = "Copy has completed."
   LMsg = LMsg & Chr(10) & "There are " & LWBCount & " new workbooks that you need to save."
   LMsg = LMsg & Chr(10) & "You can view the new workbooks under the Windows menu."

   MsgBox LMsg

End Sub
(Visited 3 times, 1 visits today)