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