Estoy trabajando en una macro que me copie los valores de celda disponible en las columnas J, K, M y N en la columnas F y G debajo del primer valor con celda dependiendo el caso, la macro que tengo es la que muestro a continuacion y la que ejecuto por medio un boton con nombre "VH"
Sub InsertarDato()
Dim Celda As Range
Dim UltimaFila As Long, x As Long
Dim Valores(1 To 4) As Integer
Let UltimaFila = Cells(Rows.Count, 10).End(xlUp).Row
Valores(1) = 0: Valores(2) = 1: Valores(3) = 3: Valores(4) = 4
For Each Celda In Range("J3:J" & UltimaFila)
For x = 1 To 4
If Celda.Offset(0, Valores(x)) <> "" Or Celda.Offset(0, Valores(x)) <> 0 Then
If Valores(x) = 0 Or Valores(x) = 1 Then
Celda.Offset(Valores(x) + 1, -4).Formula = "=" & Celda.Offset(0, Valores(x)).Address(0, 0)
Else
Celda.Offset(Valores(x) - 2, -3).Formula = "=" & Celda.Offset(0, Valores(x)).Address(0, 0)
End If
End If
Next x
Next Celda
End Sub
La tabla antes de ejecutar la macro la muestro en esta imagen:
Pero cuando ejecuto la macro no me resulta como espero y me queda asi:
en lugar de asi que es lo que espero al ejecutar el codigo:
Que puedo hacer para que el codigo me funcione? ya que segun lo que he probado donde da error es en el caso 2, ya que copia los valores en celdas sin espacio disponible, he intentado agregar una condicion a la macro con if
o elseif
adicional pero no lo he logrado o mejor dicho no se como hacerlo,agradeceria su ayuda en esta situacion si es posible.
A continuacion describo los casos que debe cumplir la macro en las condicicones,
Caso 1: *Cuando las celdas de las columnas J y K tengan un registro, se deben copiar en la columna F en los espacios disponibles debajo de la celda con valor; por ejemplo si las celdas J3 y K3 tienen un valor numerico se debe copiar el valor de celda en las celdas F4 y F5 respectivamente. *Cuando las celdas de las columnas M y N tengan un registro, se deben copiar en la columna G en los espacios disponibles debajo de la celda con valor; por ejemplo si las celdas M3 y N3 tienen un valor numerico se debe copiar el valor de celda en las celdas G4 y G5 respectivamente.
Caso 2: *Cuando la celda de la columnas K tenga un registro, se deben copiar en la columna F en el espacios disponible debajo de la celda con valor; por ejemplo si las celdas K6 tiene un valor numerico se debe copiar el valor de celda en la celda F7. *Cuando la celda de la columna N tengan un registro, se deben copiar en la columna G en el espacio disponible debajo de la celda con valor; por ejemplo si la celda N6 tiene un valor numerico se debe copiar el valor de celda en la celda G7.
Caso 3: *Cuando la celda de la columnas J tenga un registro, se deben copiar en la columna F en el espacios disponible debajo de la celda con valor; por ejemplo si las celdas J8 tiene un valor numerico se debe copiar el valor de celda en la celda F9. *Cuando la celda de la columna M tengan un registro, se deben copiar en la columna G en el espacio disponible debajo de la celda con valor; por ejemplo si la celda M8 tiene un valor numerico se debe copiar el valor de celda en la celda G9.
Caso 4: Cuando las celdas de las columnas J, K, M, y N tengan valores iguals a "0" ó " ", la macro no debe copiar valores, debe omitir y seguir evalando los casos 1, 2 y 3.
IMPORTANTE: Siempre van a haber los espacios disponibles necesarios para copiar y pagar los valores de celda en todos los casos ya que esa es otra macro que ejecuto con anterioridad.
Tambien les comparto el drive del archivo que estoy trabajando https://drive.google.com/file/d/1L-c0zrLz4U5S6RNFjMl27RK0fXOSHZr-/view?usp=sharing
Les comparto la macro que estube trabajando con @gbianchi
Sub InsertarDatos()
Let UltimaFila = Cells(Rows.Count, 4).End(xlUp).Row
Dim i
i = 3
Do While (i < UltimaFila)
''caso 1
If (Range("J" & i).Value <> "" And Range("K" & i).Value <> "") Then
''aca copiamos los valores segun corresponde, a las celdas que queremos
Range("F" & (i + 1)).Value = "=" & Range("J" & i).Address
Range("F" & (i + 2)).Value = "=" & Range("K" & i).Address
Range("G" & (i + 1)).Value = "=" & Range("M" & i).Address
Range("G" & (i + 2)).Value = "=" & Range("N" & i).Address
'..si hay mas copias...
''y ahora, aumentamos i a la siguiente linea a procesar
i = i + 3
''caso 2
ElseIf (Range("K" & i).Value <> "") Then
Range("F" & (i + 1)).Value = "=" & Range("K" & i).Address
Range("G" & (i + 1)).Value = "=" & Range("N" & i).Address
'.... hacemos las copias..
''aumentamos i
i = i + 2
''caso 3
ElseIf (Range("J" & i).Value <> "") Then
Range("F" & (i + 1)).Value = "=" & Range("J" & i).Address
Range("G" & (i + 1)).Value = "=" & Range("M" & i).Address
'.... hacemos las copias...
''aumentamos i
i = i + 2
''caso 4
Else
End If
Loop
End Sub
If
yelse
solo andan en los casos 1 , 3 y 4, el caso 2 es el problema y no se que hacer ya que esas condiciones no me funcionan cuando solo tengo que copiar valores de la columna K y N en las columnas F y G