Macro para copiar celdas con una condición
Soy nuevo en esto de las macros por ello me atrevo a molestarles en este foro.
La macro que intento realizar debe hacer lo siguiente:
Validar si la celda E2 (telefono2)tiene una longitud menor a 9 caracteres, entonces se desplace a las celdas G2, H2, I2, J2 y realice la misma validación hasta que encuentre la primer celda del mismo renglón que tenga más de 9 caracteres, y una vez que la encuentre la copie a la celda E2, y así sucesivamente.
aqui agrego el codigo que he realizado pero siempre al inicio me marca un error.
Sub Telefono2()
Hoja1.Activate
Range("E2").Select
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Range("F" & i).Value = "ERROR" Then
If Len(Range("G" & i)) > 9 Then GoTo G Else
If Len(Range("H" & i)) > 9 Then GoTo H Else
If Len(Range("I" & i)) > 9 Then GoTo I Else
If Len(Range("J" & i)) > 9 Then GoTo J Else
GoTo X
G:
Sheets("TyColima").Range("E" & i) = Sheets("TyColima").Range("G" & i)
GoTo X
H:
Sheets("TyColima").Range("E" & i) = Sheets("TyColima").Range("H" & i)
GoTo X
I:
Sheets("TyColima").Range("E" & i) = Sheets("TyColima").Range("I" & i)
GoTo X
J:
Sheets("TyColima").Range("E" & i) = Sheets("TyColima").Range("J" & i)
End If
X:
i = i + 1
Next i
End Sub
1 Respuesta
Te anexo la macro
Sub Validar_Telefonos()
'Por.Dante Amor
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Len(Cells(i, "E")) < 9 Then
uc = Cells(i, Columns.Count).End(xlToLeft).Column
If uc < Columns("G").Column Then uc = Columns("G").Column
For j = Columns("G").Column To uc
If Len(Cells(i, j)) > 9 Then
Cells(i, "E") = Cells(i, j)
Exit For
End If
Next
End If
Next
MsgBox "Fin"
End Sub
