Actualizar macro para que se ejecute solo en la fila donde esta activa

Sub pegarB1()
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
With Range("A10").CurrentRegion 'CELDA INICIAL
    f = .Rows.Count
    c = 10 'NUMERO DE CELDAS
End With
Set numeros = Range("A10").Resize(f - 1, c) 'CELDA INICIAL
Set resultado = Range("L10").Resize(f - 1, c) 'CELDA DONDE EMPIEZA A PEGAR
matriz = resultado
For i = 1 To f - 1
x = 1
    For j = 1 To c
        numero = numeros.Cells(i, j)
        If IsNumeric(numero) Then
            matriz(i, x) = numero
            x = x + 1
    End If
    Next j
Next i
Range(resultado.Address) = matriz
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

Buena  tarde. Solicito de su ayuda para darle una actualización a  la siguiente macro que anteriormente me habían proporcionado por esta pagina y me ha servido de maravilla.

Básicamente lo que hace la macro es copiar lo del rango de las columnas "A y J" y pegarlo apartir de la columna "L" eliminando las celdas en blanco. Y lo hace a todo el rango completo, osea hasta la ultima fila que este con datos, en la imagen que coloco arriba de la macro es como da el resultado.

AHORA lo que necesito de su ayuda, es actualizar la macro para que solo ejecute y de el resultado de la fila en donde se encuentra activa en la hoja.. Ejemplo, si esta activa la celda de cualquier columna de la fila 10, entonces solo ejecute y de el resultado de esa fila. Sin que se mueva de celda donde se encuentra activa. A continuación inserto una imagen de como debe quedar el resultado.

Como pueden observar esta activa en alguna columna la fila "10" y debe quedar dar el resultado solo de esa fila y no todo el rango.

No tengo conocimientos de macros y tal vez sea algo sencillo o tal vez no. Por eso necesito de su ayuda. La macro me la proporcionaron por esta maravillosa pagina

1 Respuesta

Respuesta
1

Prueba esto:

Sub copiavalores()
  Dim fila As Long, i As Long, j As Long
  fila = ActiveCell.Row
  j = 12
  For i = 1 To 10
    If Cells(fila, i) <> "" Then
      Cells(fila, j).Value = Cells(fila, i)
      j = j + 1
    End If
  Next
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas