¿Cómo combino dos macros que hacen lo que necesito?
Tengo que aplicar dos macros a muchos archivos en excel,
Pero es laborioso estar haciendo manualmente algunos procesos para las macros.
¿Cómo fusiono estas dos macros?
¿Se requiere de hacer una nueva macro?
Me refiero a las macros de las dos preguntas anteriores para realizar lo siguiente:
Me gustaría que la macro tome solo algunos datos de una lista vertical y los acomode horizontalmente pero empezando por el que menos datos tiene.
Las macros no las pude copiar aquí, pero son las que me eviaron en las 2 anteriores preguntas, o bien, si es necesario se las mando a algún e-mail.
1 respuesta
Quieres que la macro inicie con los datos que pusiste de ejemplo de glucosa, bilirrubina, ¿etc y luego que se ejecute la segunda macro? ¿Correcto?
Entonces utiliza esta macro:
Ahora necesitas 5 hojas. En la hoja1 pon tus datos, las hojas 2, 3 y 4 las utiliza la macro y en la hoja5 quedará tu resultado.
Ejecuta la macro1. La macro1 en automático ejecutará la macro ordenar.
Sub Macro1()
'Por.DAM
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
Set h3 = Sheets("Hoja3")
h2.AutoFilterMode = False
h2.Cells.Clear
h3.Cells.Clear
h1.Cells.Copy h2.Range("A1")
h2.Columns("A:C").AutoFilter
u = h1.Range("B" & Rows.Count).End(xlUp).Row
h2.Range("A1:C" & u).AutoFilter Field:=3, Criteria1:="<>"
With h2.Sort
.SortFields.Clear: .SortFields.Add Key:=h2.Range("B1:B" & u)
.SetRange h2.Range("A1:C" & u): .Header = xlGuess: .Apply
End With
h2.Range("B2:B" & u).Copy h3.Range("A1")
h3.Range("A1:A" & u).RemoveDuplicates Columns:=1, Header:=xlNo
h3.Range("A1:A" & u).Copy
h3.Range("D1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
h3.Range("A1:A" & u).ClearContents
For i = 1 To u
If h1.Cells(i, "C") <> "" Then
Set b = h3.Rows(1).Find(h1.Cells(i, "B"))
If Not b Is Nothing Then
u3 = h3.Cells(Rows.Count, b.Column).End(xlUp).Row + 1
h3.Cells(u3, b.Column) = h1.Cells(i, "C")
End If
End If
Next
For i = 4 To u + 4
With h3.Sort
.SortFields.Clear: .SortFields.Add Key:=h3.Cells(1, i)
.SetRange h3.Range(h3.Cells(1, i), h3.Cells(u, i)): .Header = xlYes: .Apply
End With
Next
ordenar
Application.ScreenUpdating = True
MsgBox "Finalizado ordenar datos"
End Sub
Sub ordenar()
'Por.DAM
Set h1 = Sheets("Hoja3")
Set h2 = Sheets("Hoja4")
Set h3 = Sheets("Hoja5")
h2.Cells.Clear
h3.Cells.Clear
For i = 4 To h1.Cells(1, Columns.Count).End(xlToLeft).Column
u = h1.Cells(Rows.Count, i).End(xlUp).Row
h2.Cells(i, "A") = i
h2.Cells(i, "B") = u
Next
u2 = h2.Range("B" & Rows.Count).End(xlUp).Row
With h2.Sort
.SortFields.Clear: .SortFields.Add Key:=h2.Range("B1:B" & u2)
.SetRange h2.Range("A1:B" & u2): .Header = xlGuess: .Apply
End With
For i = 1 To h2.Range("B" & Rows.Count).End(xlUp).Row
h1.Columns(h2.Cells(i, "A")).Copy h3.Columns(i)
Next
For i = 1 To u2
With h3.Sort
.SortFields.Clear: .SortFields.Add Key:=h3.Cells(1, i)
.SetRange h3.Range(h3.Cells(1, i), h3.Cells(u2, i)): .Header = xlYes: .Apply
End With
Next
h3.Select
End Sub
Muchísimas Gracias. Todo quedó a la perfección.
Voy a intentar lo que sigue y si no me sale los estaré consultando.
Hasta luego.
