Recorrer una columna, mover datos y combinar celdas
Tengo un archivo con bastantes partidas..
Necesito que me recorra la columna "B" donde está la palabra "Partida", una vez encontrada la palabra "Partida, se vaya a la celda en la misma fila y la columna "M", luego me recorra la columna "M" hacia abajo, hasta donde se encuentre la primera celda con datos.
Una vez aquí, tengo que mover los datos de ésta celda a la contigua a la izquierda, es decir (Filax, Columna L), una vez movidos los datos, tengo que combinar las celdas (x, L y x, M), y alinearlos a la derecha.
Ya tendríamos corregida la primera partida, por lo que necesito volver a la columna "B" y seguir recorriendo ésta columna hasta la siguiente "Partida".
1 respuesta
Te mando la solución sigue mis instrucciones:
Posiciónate en la primera celda de la columna B y ejecuta esta macro:
Sub prueba() Do While ActiveCell.Value <> "" If ActiveCell.Value = "partida" Then posicion = ActiveCell.Address ActiveCell.Offset(0, 11).Select Do While ActiveCell.Value = "" ActiveCell.Offset(1, 0).Select Loop If ActiveCell <> "" Then Range(ActiveCell, ActiveCell.Offset(0, -1)).Select With Selection .Merge .HorizontalAlignment = xlRight End With End If Range(posicion).Select End If ActiveCell.Offset(1, 0).Select Loop End Sub
recuerda finalizar y puntuar
Algo hay que no supe explicar.
En la columna B la mayoría de las celdas están en blanco, otras contienen la palabra "Capítulo" y otras contienen la palabra "Partida".
Tengo que acotar para que corra entre xxx nº de filas. Por ejemplo entre la fila 4 y la 2000
Pues, en ese caso, utiliza esta macro para corregir el problema de la columna B
Sub prueba()
Range("b65000").End(xlUp).Offset(1, 0).Value = "final"
Do While ActiveCell.Value <> "final"
If ActiveCell.Value = "partida" Then
posicion = ActiveCell.Address
ActiveCell.Offset(0, 11).Select
Do While ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
If ActiveCell <> "" Then
Range(ActiveCell, ActiveCell.Offset(0, -1)).Select
With Selection
.Merge
.HorizontalAlignment = xlRight
End With
End If
Range(posicion).Select
End If
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.ClearContents
End Sub
