A ver, para no estar adivinando o caminando a ciegas por el problema, vamos a ir a lo seguro:
Por
Victor7 , · publicado el 13 de junio 13 jun
Hola tengo esta macro si me funciona pero me pregunto si hay manera de modificarla y no repita las lineas de código ya que necesito que se haga la búsqueda hasta la columna DL
Tengo una serie de datos mas o menos asi:
A__M__N__DK__DL
1__4__5__2___3
3__6__7__6___1
3__2__6__12__11
4__1__1__4___9
7__3__2__13__32
9__3__5__7___5
9__2__4__3___90
DP_DQ_DR_DS_DT
1__4__9__11_14
3__8__21_39_51
4__1__2__6__15
7__3__5__18_50
9__5__14_24_119
Sub sumarsi()
Application.ScreenUpdating = False
Dim uf As Long, uf2 As Long
Dim rangocriterio As Range
Dim rangosuma1 As Range
Dim rangosuma2 As Range
Dim rangosuma3 As Range
uf = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:A" & uf).AdvancedFilter 2, CriteriaRange, Range("DP1"), Unique:=True 'CAMBIO
Set rangocriterio = Range("A2:A" & uf)
Set rangosuma1 = Range("M2:M" & uf)
Set rangosuma2 = Range("N2:N" & uf)
Set rangosuma3 = Range("O2:O" & uf)
'********************************+
Set rangosuma4 = Range("P2:P" & uf)
Set rangosuma5 = Range("Q2:Q" & uf)
Set rangosuma6 = Range("R2:R" & uf)
Set rangosuma7 = Range("S2:S" & uf)
Set rangosuma8 = Range("T2:T" & uf)
Set rangosuma9 = Range("U2:U" & uf)
Set rangosuma10 = Range("V2:V" & uf)
Set rangosuma11 = Range("W2:W" & uf)
Set rangosuma12 = Range("X2:X" & uf)
Set rangosuma13 = Range("Y2:Y" & uf)
Set rangosuma14 = Range("Z2:Z" & uf)
Set rangosuma15 = Range("AA2:AA" & uf)
Range("DQ1") = Range("M1"): Range("DR1") = Range("N1"): Range("DS1") = Range("O1"): Range("DT1") = Range("P1"): Range("DU1") = Range("Q1"): Range("DV1") = Range("R1")
Range("DW1") = Range("S1"): Range("DX1") = Range("T1"): Range("DY1") = Range("U1"): Range("DZ1") = Range("V1"): Range("EA1") = Range("W1"): Range("EB1") = Range("X1")
'CAMBIOFILA 1
uf2 = Range("DP" & Rows.Count).End(xlUp).Row 'CAMBIO AQUÍ
With Range("DQ2:DQ" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma1.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("DR2:DR" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma2.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
'********+PRUEBA D
With Range("DS2:DS" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma3.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
'***********************************************************
With Range("DT2:DT" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma4.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("DU2:DU" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma5.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("DV2:DV" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma6.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("DW2:DW" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma7.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("DX2:DX" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma8.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("DY2:DY" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma9.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("DZ2:DZ" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma10.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("EA2:EA" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma11.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("EB2:EB" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma12.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("EC2:EC" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma13.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("ED2:ED" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma14.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("EE2:EE" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma15.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
' FIN DE PRUEBA
Set rangocriterio = Nothing
Set rangosuma1 = Nothing
Set rangosuma2 = Nothing
Set rangosuma3 = Nothing
Set rangosuma4 = Nothing
Set rangosuma5 = Nothing
Set rangosuma6 = Nothing
Set rangosuma7 = Nothing
Set rangosuma8 = Nothing
Set rangosuma9 = Nothing
Set rangosuma10 = Nothing
Set rangosuma11 = Nothing
Set rangosuma12 = Nothing
Set rangosuma13 = Nothing
Set rangosuma14 = Nothing
Set rangosuma15 = Nothing
Application.ScreenUpdating = True
End Sub
Gracias por su ayuda
ayuda1.zip