Macro para Reordenar
La verdad tengo este problema no se si pueden ayudar porque creo que es muy difícil logar esto:
A B C
10 Producto1 100
50 Productox 450
21 Producto13 300
10 Producto1 200
50 Productox 120
Tengo una lista como esta arriba lo que ocurre es que como ven el producto y su código son lo mismo pero las cantidades varían (C) y lo que deseo es que las reordene en la hoja2 dela siguiente manera
hoja2:
A B
10 producto1
100
200
(vacio)
50 productox
450
120
(vacio)
21 producto13
300
Creo que lo que pido no se puede ; de ser así espero que me lo digan de todas maneras gracias.
A B C
10 Producto1 100
50 Productox 450
21 Producto13 300
10 Producto1 200
50 Productox 120
Tengo una lista como esta arriba lo que ocurre es que como ven el producto y su código son lo mismo pero las cantidades varían (C) y lo que deseo es que las reordene en la hoja2 dela siguiente manera
hoja2:
A B
10 producto1
100
200
(vacio)
50 productox
450
120
(vacio)
21 producto13
300
Creo que lo que pido no se puede ; de ser así espero que me lo digan de todas maneras gracias.
Respuesta de newmodel
1
Te envío una propuesta...
La macro primero ordena por Columna A y después hace las operaciones que indicas...
Sub bdClasifica()
Dim TotalReg As Long
Dim i, x, r As Long
Dim IdProd As String
TotalReg = Range("a65500").End(xlUp).Row + 1
Range("A1:C" & TotalReg).Select
ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add Key:=Range("A2:A" & TotalReg), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Hoja1").Sort
.SetRange Range("A1:C" & TotalReg)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For i = 2 To TotalReg
If Cells(i - 1, 1) = Cells(i, 1) Then
GoTo 9
End If
If Cells(i, 1) = "" Then Exit For
IdProd = Cells(i, 1)
r = Sheets("Hoja2").Range("b65500").End(xlUp).Row + 2
Range("a" & i & ":" & "b" & i).Copy Sheets("Hoja2").Range("a" & r)
For x = i To TotalReg - 1
If IdProd = Cells(x, 1) Then
Cells(x, 3).Copy Sheets("Hoja2").Range("b65500").End(xlUp)(2)
End If
Next
9:
Next
End Sub
Saludos y cualquier cosa no dudes en consultarme...
La macro primero ordena por Columna A y después hace las operaciones que indicas...
Sub bdClasifica()
Dim TotalReg As Long
Dim i, x, r As Long
Dim IdProd As String
TotalReg = Range("a65500").End(xlUp).Row + 1
Range("A1:C" & TotalReg).Select
ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add Key:=Range("A2:A" & TotalReg), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Hoja1").Sort
.SetRange Range("A1:C" & TotalReg)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For i = 2 To TotalReg
If Cells(i - 1, 1) = Cells(i, 1) Then
GoTo 9
End If
If Cells(i, 1) = "" Then Exit For
IdProd = Cells(i, 1)
r = Sheets("Hoja2").Range("b65500").End(xlUp).Row + 2
Range("a" & i & ":" & "b" & i).Copy Sheets("Hoja2").Range("a" & r)
For x = i To TotalReg - 1
If IdProd = Cells(x, 1) Then
Cells(x, 3).Copy Sheets("Hoja2").Range("b65500").End(xlUp)(2)
End If
Next
9:
Next
End Sub
Saludos y cualquier cosa no dudes en consultarme...
