Anónimo
Macro para copiar datos de dos columnas especial
En una hoja de Excel tengo cinco columnas con varias referencias. Me interesan dos columnas en concreto, la A y la DE, en la columna A tengo la referencia de varios productos y en la columna DE están la configuración. Como ejemplo, tengo 00123 rojo, 00123 blanco, 00123 verde, 00121 rojo, 00121 blanco, 00121 verde, etc… La columna A es la de los números y la DE la de los colores. Necesito crear una macro para copiar en otra hoja los datos de estas dos columnas, pero con la siguiente particularidad. Los números de la columna A se tendrían que copiar pero solo una vez, o sea los repetidos no, y los colores de la columna DE se tendrían que ir colocando el las columnas siguientes. O sea que quedaría por ejemplo en la hoja nueva: A1 (00123), B1 (rojo), C1 (blanco), D1 (verde) ; A2 (00121), B2 (rojo), C2 (blanco), D2 (verde) y así sucesivamente. Gracias por la ayuda
1 respuesta
Respuesta de Luis_P
1
Ok
Tenemos hoja1 y hoja2 pasar datos de hoja1 a hoja2
Entonces, acá esta el macro:
Sub distribuir()
Dim i As Long
Dim ii As Long
Dim r As Range
Dim c As Integer
Dim n As Integer
' LP 19102011
Sheets(1).Select
i = Application.WorksheetFunction.CountA(Sheets(1).Range("a:a"))
If i = 0 Then Exit Sub
Application.ScreenUpdating = False
Columns("A:A").Select
Selection.Copy
ActiveSheet.Next.Select
[a1].Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
n = Application.WorksheetFunction.CountA(Sheets(2).Range("a:a"))
For Each r In Sheets(2).Range("A1:" & "A" & n)
For ii = 1 To i
If r = Sheets(1).Range("a" & ii) Then
c = (c + 1)
r.Offset(0, c) = Sheets(1).Range("d" & ii)
r.Offset(0, c).Interior.Color = Sheets(1).Range("d" & ii).Interior.Color
End If
Next
c = 0
DoEvents
Next
Set r = Nothing
[a1].Select
Application.ScreenUpdating = True
MsgBox "Terminado", vbInformation
End Sub
Se llama "distribuir"
Pégalo en un modulo desde el editor de visual basic o graba un macro cualquiera y reemplázalo por el que te indico.
Nota: Evita ser bloqueado CIERRA las preguntas si la respuesta es satisfactoria
Tenemos hoja1 y hoja2 pasar datos de hoja1 a hoja2
Entonces, acá esta el macro:
Sub distribuir()
Dim i As Long
Dim ii As Long
Dim r As Range
Dim c As Integer
Dim n As Integer
' LP 19102011
Sheets(1).Select
i = Application.WorksheetFunction.CountA(Sheets(1).Range("a:a"))
If i = 0 Then Exit Sub
Application.ScreenUpdating = False
Columns("A:A").Select
Selection.Copy
ActiveSheet.Next.Select
[a1].Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
n = Application.WorksheetFunction.CountA(Sheets(2).Range("a:a"))
For Each r In Sheets(2).Range("A1:" & "A" & n)
For ii = 1 To i
If r = Sheets(1).Range("a" & ii) Then
c = (c + 1)
r.Offset(0, c) = Sheets(1).Range("d" & ii)
r.Offset(0, c).Interior.Color = Sheets(1).Range("d" & ii).Interior.Color
End If
Next
c = 0
DoEvents
Next
Set r = Nothing
[a1].Select
Application.ScreenUpdating = True
MsgBox "Terminado", vbInformation
End Sub
Se llama "distribuir"
Pégalo en un modulo desde el editor de visual basic o graba un macro cualquiera y reemplázalo por el que te indico.
Nota: Evita ser bloqueado CIERRA las preguntas si la respuesta es satisfactoria