¿Quien puede corregir mi error de macro para cortar/copiar datos con macros?

Tengo una hoja llena de datos en el rango A156:H6000

Lo que necesito es que cuando tenga datos la columna "G", que me corte los datos de las columnas A, b, c, d, e, f, g, h y los pase/desplace a la columna K

Trate de armar esta macro, pero la verdad aunque esté vacío la celda "G" aún así me copia los datos de las columnas antes mencionado y me los pega en la columna "K"

Sub acelera()

Ini = "G146"

fin = Range("G" & Rows.Count).End(xlUp).Row

For i = fin To 146  step -1
'If Not IsEmpty(Range(Ini).Offset(i).Value) Then
If Not IsEmptyActiveCell Then
Range("A" & i & ",B" & i & ",C" & i & ",D" & i & ",E" & i & ",G" & i & ":H" & i).Copy Cells(i, 11)
Else
ActiveCell.Interior.ColorIndex = 0
End If
Next

End Sub

2 respuestas

Respuesta
2

Pareciera que recorres la col G desde el final hasta la fila 146. Pero en ninguna línea seleccionas alguna celda.

Entonces en lugar de evaluar 'ActiveCell' debes evaluar el rango G

For i = fin To 146  step -1
If Not IsEmpty Range("G" & i) Then

Range("A" & i & ",B" & i & ",C" & i & ",D" & i & ",E" & i & ",G" & i & ":H" & i).Copy Cells(i, 11)
Else
Range("G" & i).Interior.ColorIndex = 0    'esto si necesitas cambiarle el color a la celda de col G
End If
Next

Me marca error

¿Dónde?.?

Si es en la de la evaluación intenta así:

If Range("G"& I) <> "" then

¡Gracias! 

efectivamente era en Range en If Not IsEmpty Range("G" & i) Then

la cual sustituyendo con la instrucción sugerida Funcionó, Gracias

Respuesta
1

Prueba de estas manera

fin = Range("G" & Rows.Count).End(xlUp).Row

For i = 146 To fin
If Cells(i, "G") <> "" Then
Range(Cells(i, "a"), Cells(i, "H")).Cut
Cells(i, "K").Select
ActiveSheet.Paste
Else
ActiveCell.Interior.ColorIndex = 0
End If
Next

Si te silve no olvides valora para cerrar la pregunta 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas