Encontrar ultima fila y bajar una celda más
De antemano agradezco la ayuda que me brindes, tengo una macro que me busca un valor determinado y copia varias columnas, pengandolas en otras columnas, el problema que tengo es que solo puede buscar un valor por y al pegar los datos en la otra columnas los encima, estas es la macro
Busca el valor "COD" y lo pega en la columna P 2, quisiera agregar tres conceptos más 2V, EFE, y CRE y que los vaya agregando al final del ultimo,
Sub Cod()
Dim r As Long
Dim a As Long
lastrow = Range("A1000000").End(xlUp).Row
a = 2
For r = 2 To lastrow
Cells(r, 4).Select
If Cells(r, 4).Value = "COD" Then
Range("P" & Rows.Count).End(xlUp).Offset(2, 0).Select
Cells(a, 16).Value = Cells(r, 5).Value
Cells(a, 17).Value = Cells(r, 6).Value
Cells(a, 18).Value = Cells(r, 7).Value
Cells(a, 19).Value = Cells(r, 9).Value
a = a + 1
End If
Next r
End Sub
Que tengas una excelente tarde
Busca el valor "COD" y lo pega en la columna P 2, quisiera agregar tres conceptos más 2V, EFE, y CRE y que los vaya agregando al final del ultimo,
Sub Cod()
Dim r As Long
Dim a As Long
lastrow = Range("A1000000").End(xlUp).Row
a = 2
For r = 2 To lastrow
Cells(r, 4).Select
If Cells(r, 4).Value = "COD" Then
Range("P" & Rows.Count).End(xlUp).Offset(2, 0).Select
Cells(a, 16).Value = Cells(r, 5).Value
Cells(a, 17).Value = Cells(r, 6).Value
Cells(a, 18).Value = Cells(r, 7).Value
Cells(a, 19).Value = Cells(r, 9).Value
a = a + 1
End If
Next r
End Sub
Que tengas una excelente tarde
Respuesta de agusting
1
Creo que con este código te funcionará. Mientras haya valores no vacíos en la columna A, va ejecutando lo siguiente: si el valor de la 4ª columna es COD o 2V o EFE o CRE, entonces se lleva los valores de la columnas 5,6,7,9 a las columnas 16,17,18,19.
Sub Cod()
Dim r, a As Long
a = 2
r = 2
Do While Cells(r, 1).Value <> ""
Cells(r, 4).Select
If (Cells(r, 4).Value = "COD" Or Cells(r, 4).Value = "2V") Or (Cells(r, 4).Value = "EFE" Or Cells(r, 4).Value = "CRE") Then
Cells(a, 16).Value = Cells(r, 5).Value
Cells(a, 17).Value = Cells(r, 6).Value
Cells(a, 18).Value = Cells(r, 7).Value
Cells(a, 19).Value = Cells(r, 9).Value
a = a + 1
End If
r = r + 1
Loop
End Sub
Sub Cod()
Dim r, a As Long
a = 2
r = 2
Do While Cells(r, 1).Value <> ""
Cells(r, 4).Select
If (Cells(r, 4).Value = "COD" Or Cells(r, 4).Value = "2V") Or (Cells(r, 4).Value = "EFE" Or Cells(r, 4).Value = "CRE") Then
Cells(a, 16).Value = Cells(r, 5).Value
Cells(a, 17).Value = Cells(r, 6).Value
Cells(a, 18).Value = Cells(r, 7).Value
Cells(a, 19).Value = Cells(r, 9).Value
a = a + 1
End If
r = r + 1
Loop
End Sub
agusting muchas gracias por tu ayuda, de verdad te quedo perfecta, que Dios te bendiga y te siga dando mucha sabiduría para ayudar, que tengas un excelente día
