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