MS Excel 2003: copie datos en varias hojas de trabajo según los valores de la columna A

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: copie datos en varias hojas de trabajo según los valores de la columna A

Este tutorial de Excel explica cómo escribir una macro para copiar datos en varias hojas de cálculo (con capturas de pantalla e instrucciones paso a paso) según los valores de una columna en Excel 2003 y versiones anteriores.

Pregunta: En Microsoft Excel 2003/XP/2000/97, ¿cómo escribo una macro que hace lo siguiente?

  • Si la columna A (en la lista de materiales) contiene una “A”, cambie la fila a negrita y justifique a la izquierda la fila, y agregue una fila en blanco encima.
  • Si la columna A (en la hoja de trabajo BOM) contiene una “P”, copie algunas celdas de esa fila en la hoja de trabajo “PICK LIST”.
  • Si la columna A (en la hoja de trabajo BOM) contiene una “S”, copie algunas celdas de esa fila en la hoja de trabajo “PIEZAS DE CIZALLA”.
  • Si la columna A (en la hoja de cálculo BOM) contiene una “T”, copie algunas celdas de esa fila en la hoja de cálculo “TRUMPF”.

También quiero poner un borde alrededor de la lista de materiales y todas las celdas de las hojas “LISTA DE SELECCIÓN”, “PIEZAS DE CIZALLA” y “TRUMPF” que contienen datos, y completar la fórmula en la columna I de la lista de materiales.

¿Cómo puedo hacer todo esto?

R: Veamos un ejemplo.

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

En nuestra hoja de cálculo, tenemos una hoja maestra llamada BOM que contiene los datos originales y queremos copiar los datos en 3 hojas: “PICK LIST”, “SHEAR PARTS” y “TRUMPF”.

Cuando se encuentra una “A” en la columna A, la fila está en negrita y alineada a la izquierda, y se agrega una fila en blanco encima (excepto que no hay una fila en blanco encima de la primera fila). Cuando se encuentra una “P” en la columna A, el contenido de esa fila se copia en la tabla “PICK LIST”. Cuando se encuentra una “S” en la columna A, el contenido de esa fila se copia en la tabla “PARTES DE CIZALLA”. Cuando se encuentra una “T” en la columna A, el contenido de esa fila se copia en la tabla “TRUMPF”.

Además, hemos calculado la fórmula para la columna I, por ejemplo, =H14*Cantidad en la celda I14.

Puede ejecutar macros seleccionando Macros > Macros en el menú Herramientas.

Luego seleccione la macro llamada CopyData y haga clic en el botón Ejecutar.

Cuando la macro esté completa, aparecerá el cuadro de mensaje anterior.

Como puede ver, en la hoja de trabajo BOM, cada fila con un valor “A” en la columna A está en negrita y alineada a la izquierda. De nuevo, la fórmula se ha completado en la columna I.

En la hoja de trabajo “PICK LIST”, los datos se han copiado en la ubicación con el valor “P” en la columna A de la lista de materiales.

En la tabla “PARTES DE CIZALLA”, los datos se han replicado con el valor “S” en la columna A de la tabla BOM.

En la hoja de trabajo “TRUMPF”, los datos se han copiado en la lista de materiales donde el valor es “T” en la columna A.

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

codigo macro

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

Sub CopyData()

   Dim LSheetMain As String
   Dim LSheetP As String
   Dim LSheetS As String
   Dim LSheetT As String
   Dim LContinue As Boolean
   Dim LFirstRow As Integer
   Dim LRow As Integer
   Dim LCurPRow As Integer
   Dim LCurSRow As Integer
   Dim LCurTRow As Integer

   'Set up names of sheets
   LSheetMain = "BOM"
   LSheetP = "PICK LIST"
   LSheetS = "SHEAR PARTS"
   LSheetT = "TRUMPF"

   'Initialize variables
   LContinue = True
   LFirstRow = 13
   LRow = LFirstRow
   LCurPRow = 12
   LCurSRow = 12
   LCurTRow = 12

   Sheets(LSheetMain).Select

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

      'Found a blank cell, do not continue
      If Len(Range("A" & CStr(LRow)).Value) = 0 Then
         LContinue = False

      'Copy and format data
      Else

         'Place borders around cells
         Range("A" & CStr(LRow) & ":I" & CStr(LRow)).Borders(xlEdgeLeft).LineStyle = xlContinuous
         Range("A" & CStr(LRow) & ":I" & CStr(LRow)).Borders(xlEdgeLeft).Weight = xlThin
         Range("A" & CStr(LRow) & ":I" & CStr(LRow)).Borders(xlEdgeTop).LineStyle = xlContinuous
         Range("A" & CStr(LRow) & ":I" & CStr(LRow)).Borders(xlEdgeTop).Weight = xlThin
         Range("A" & CStr(LRow) & ":I" & CStr(LRow)).Borders(xlEdgeBottom).LineStyle = xlContinuous
         Range("A" & CStr(LRow) & ":I" & CStr(LRow)).Borders(xlEdgeBottom).Weight = xlThin
         Range("A" & CStr(LRow) & ":I" & CStr(LRow)).Borders(xlEdgeRight).LineStyle = xlContinuous
         Range("A" & CStr(LRow) & ":I" & CStr(LRow)).Borders(xlEdgeRight).Weight = xlThin
         Range("A" & CStr(LRow) & ":I" & CStr(LRow)).Borders(xlInsideVertical).LineStyle = xlContinuous
         Range("A" & CStr(LRow) & ":I" & CStr(LRow)).Borders(xlInsideVertical).Weight = xlThin

         'Set up formula for column I
         Range("I" & CStr(LRow)).Formula = "=H" & CStr(LRow) & "*QTY"

         '--- "A" ---
         If Range("A" & CStr(LRow)).Value = "A" Then

            'Bold and left justify
            CStr(LRow)).Font.Bold = True
            Range(CStr(LRow) & ":" & CStr(LRow)).HorizontalAlignment = xlLeft

            'If not first row, insert blank row
            If LRow <> LFirstRow Then
               Rows(CStr(LRow) & ":" & CStr(LRow)).Select
               Selection.Insert Shift:=xlDown
               LRow = LRow + 1
            End If

         '--- "P" ---
         ElseIf Range("A" & CStr(LRow)).Value = "P" Then

            'Copy values from columns B, C, F, G, and I from BMO sheet
            Range("B" & CStr(LRow) & ",C" & CStr(LRow) & ",F" & CStr(LRow) & ",G" & CStr(LRow) & ",I" & CStr(LRow)).Select
            Selection.Copy

            'Paste onto "PICK LIST" sheet
            Sheets(LSheetP).Select
            Range("A" & CStr(LCurPRow)).Select
            Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("A1").Select

           'Place borders around cells
            Range("A" & CStr(LCurPRow) & ":E" & CStr(LCurPRow)).Borders(xlEdgeLeft).LineStyle = xlContinuous
            Range("A" & CStr(LCurPRow) & ":E" & CStr(LCurPRow)).Borders(xlEdgeLeft).Weight = xlThin
            Range("A" & CStr(LCurPRow) & ":E" & CStr(LCurPRow)).Borders(xlEdgeTop).LineStyle = xlContinuous
            Range("A" & CStr(LCurPRow) & ":E" & CStr(LCurPRow)).Borders(xlEdgeTop).Weight = xlThin
            Range("A" & CStr(LCurPRow) & ":E" & CStr(LCurPRow)).Borders(xlEdgeBottom).LineStyle = xlContinuous
            Range("A" & CStr(LCurPRow) & ":E" & CStr(LCurPRow)).Borders(xlEdgeBottom).Weight = xlThin
            Range("A" & CStr(LCurPRow) & ":E" & CStr(LCurPRow)).Borders(xlEdgeRight).LineStyle = xlContinuous
            Range("A" & CStr(LCurPRow) & ":E" & CStr(LCurPRow)).Borders(xlEdgeRight).Weight = xlThin
            Range("A" & CStr(LCurPRow) & ":E" & CStr(LCurPRow)).Borders(xlInsideVertical).LineStyle = xlContinuous
            Range("A" & CStr(LCurPRow) & ":E" & CStr(LCurPRow)).Borders(xlInsideVertical).Weight = xlThin

            'Increment row counter on "PICK LIST" sheet
            LCurPRow = LCurPRow + 1

            'Go back to BOM sheet and continue where left off
            Sheets(LSheetMain).Select

         '--- "S" ---
         ElseIf Range("A" & CStr(LRow)).Value = "S" Then

            'Copy values from columns B, C, and E from BMO sheet
            Range("B" & CStr(LRow) & ",C" & CStr(LRow) & ",E" & CStr(LRow)).Select
            Selection.Copy

            'Paste onto "SHEAR PARTS" sheet
            Sheets(LSheetS).Select
            Range("A" & CStr(LCurSRow)).Select
            Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

            'Copy values from columns D, F, G, and I from BMO sheet
            Sheets(LSheetMain).Select
            Range("D" & CStr(LRow) & ",F" & CStr(LRow) & ",G" & CStr(LRow) & ",I" & CStr(LRow)).Select
            Selection.Copy

            'Paste onto "SHEAR PARTS" sheet
            Sheets(LSheetS).Select
            Range("D" & CStr(LCurSRow)).Select
            Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("A1").Select

            'Place borders around cells
            Range("A" & CStr(LCurSRow) & ":G" & CStr(LCurSRow)).Borders(xlEdgeLeft).LineStyle = xlContinuous
            Range("A" & CStr(LCurSRow) & ":G" & CStr(LCurSRow)).Borders(xlEdgeLeft).Weight = xlThin
            Range("A" & CStr(LCurSRow) & ":G" & CStr(LCurSRow)).Borders(xlEdgeTop).LineStyle = xlContinuous
            Range("A" & CStr(LCurSRow) & ":G" & CStr(LCurSRow)).Borders(xlEdgeTop).Weight = xlThin
            Range("A" & CStr(LCurSRow) & ":G" & CStr(LCurSRow)).Borders(xlEdgeBottom).LineStyle = xlContinuous
            Range("A" & CStr(LCurSRow) & ":G" & CStr(LCurSRow)).Borders(xlEdgeBottom).Weight = xlThin
            Range("A" & CStr(LCurSRow) & ":G" & CStr(LCurSRow)).Borders(xlEdgeRight).LineStyle = xlContinuous
            Range("A" & CStr(LCurSRow) & ":G" & CStr(LCurSRow)).Borders(xlEdgeRight).Weight = xlThin
            Range("A" & CStr(LCurSRow) & ":G" & CStr(LCurSRow)).Borders(xlInsideVertical).LineStyle = xlContinuous
            Range("A" & CStr(LCurSRow) & ":G" & CStr(LCurSRow)).Borders(xlInsideVertical).Weight = xlThin

            'Increment row counter on "SHEAR PARTS" sheet
            LCurSRow = LCurSRow + 1

            'Go back to BOM sheet and continue where left off
            Sheets(LSheetMain).Select

         '--- "T" ---
         ElseIf Range("A" & CStr(LRow)).Value = "T" Then

            'Copy values from columns B from BMO sheet
            Range("B" & CStr(LRow)).Select
            Selection.Copy

            'Paste onto "TRUMPF" sheet
            Sheets(LSheetT).Select
            Range("A" & CStr(LCurTRow)).Select
            Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

            'Place comma in column B
            Range("B" & CStr(LCurTRow)).Value = ","

            'Copy values from columns I from BMO sheet
            Sheets(LSheetMain).Select
            Range("I" & CStr(LRow)).Select
            Selection.Copy

            'Paste onto "TRUMPF" sheet
            Sheets(LSheetT).Select
            Range("C" & CStr(LCurTRow)).Select
            Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("A1").Select

            'Place borders around cells
            Range("A" & CStr(LCurTRow) & ":C" & CStr(LCurTRow)).Borders(xlEdgeLeft).LineStyle = xlContinuous
            Range("A" & CStr(LCurTRow) & ":C" & CStr(LCurTRow)).Borders(xlEdgeLeft).Weight = xlThin
            Range("A" & CStr(LCurTRow) & ":C" & CStr(LCurTRow)).Borders(xlEdgeTop).LineStyle = xlContinuous
            Range("A" & CStr(LCurTRow) & ":C" & CStr(LCurTRow)).Borders(xlEdgeTop).Weight = xlThin
            Range("A" & CStr(LCurTRow) & ":C" & CStr(LCurTRow)).Borders(xlEdgeBottom).LineStyle = xlContinuous
            Range("A" & CStr(LCurTRow) & ":C" & CStr(LCurTRow)).Borders(xlEdgeBottom).Weight = xlThin
            Range("A" & CStr(LCurTRow) & ":C" & CStr(LCurTRow)).Borders(xlEdgeRight).LineStyle = xlContinuous
            Range("A" & CStr(LCurTRow) & ":C" & CStr(LCurTRow)).Borders(xlEdgeRight).Weight = xlThin
            Range("A" & CStr(LCurTRow) & ":C" & CStr(LCurTRow)).Borders(xlInsideVertical).LineStyle = xlContinuous
            Range("A" & CStr(LCurTRow) & ":C" & CStr(LCurTRow)).Borders(xlInsideVertical).Weight = xlThin

            'Increment row counter on "TRUMPF" sheet
            LCurTRow = LCurTRow + 1

            'Go back to BOM sheet and continue where left off
            Sheets(LSheetMain).Select

         End If

      End If

      LRow = LRow + 1

   Wend

   MsgBox "The copy has completed successfully."

End Sub
(Visited 10 times, 1 visits today)