Hola Romssel, esta macro te puede servir para lo que necesitas:

Private Sub SeisNumeros()
 Dim Valor6 As Long
 Application. ScreenUpdating = False
   Do While ActiveCell. Value <> Empty
       With ActiveCell
           . Offset(0, -1). Value = Valor6
            If Len(. Value) = 6 Then Valor6 =. Value:. Offset(0, -1). Value = Empty
           . Offset(1, 0). Activate
       End With
   Loop
 Application. ScreenUpdating = True
End Sub

Solo localizate en la primer celda de la columna que contiene los datos y corre la macro, dado que he dimensioinado como Long la variable hasta quen encuentre el primer datos de 6 digitos te escribirá un cero, si no deseas el cero y para no hacer más complejo el procedimiento quita o vuelve comentario la línea de la Dim, no pasa nada es una macro sencilla.

Para tu segunda pregunta francamente no entendí bien, si es o no con macros, tus columnas de resultado son las mismas que las del problema (creo se te pasó). 

Saludos... Nos vemos la próxima semana.

Q onda... Muchas gracias por responder mi pregunta, mira deja te explico bien como esta todo el asunto:

Primero tengo estas 2 columnas, la primera esta vacia y la segunda tiene datos

     Col1        Col2

Entonces yo lo q quiero es de q me repita las celdas q tienen 6 digitos de la columna 2 en la columna 1 y q este mismo valor me lo repita en todas las filas (de la misma columna1), excepto en la fila q tenga el numero de 6 digitos (en la columna2). Y es q mmmm los numeros q tienen 6 digitos, has de cuenta q son FOLIOS y los q tienen menos de 4 digitos son los q pertenecen a dicho folio, entonces por ejemplo el 1254 y el 9565 pertenecen al folio 261120, es por eso q quiero q me aparezca asi. Deja te pongo el resultado q quiero q aparezca para darme a entender mejor:

      Col 1           Col 2

Eso es de la primera pregunta, en lo q respecta a la segunda pregunta no son iguales jejeje ira deja te digo como esta el asunto de esta otra macro.

Tengo estas 3 columnas, has de cuenta q los valores de la segunda columna son FOLIOS y los de la tercer columna son los resultados de cada folio (la primera columna ni le hagas caso solo la puse para q vieras la posicion q tiene cada FOLIO), el caso es de q hay folios q se repiten, entonces lo q quiero es de q los valores de la columna 2 solamente se pongan una sola vez (y no se repitan), pero al momento de ponerlos una sola vez, entonces los valores q tienen en la columna 3, quiero se se sumen y q al igual como solo va a aprecer una sola vez en la columna dos, entonces el resultado de la columna 3 va a ser la suma de los mismos valores q se repiten en la columna 2, deja te pongo el ejemplo q habia puesto antes y checate q hay folios q se repiten, en este caso se repiten lo es el 4 con el 5 y el 14 con el 15 (pero estos son para solo esta lista de numeros, pq en realidad son cerca de 500 jajaja, bien pueden estar consecutivos como en este caso, o bien pueden estar salteados, uno está mmmm no se en la posicion 4 y otro igual puede estar en la 350 suponiendo)

Y como resultado quiero q me de esta tabla (checate los datos q tienen en la columna 3 q son 16  y veras q los folios q se repiten, se sumaron y ps ya solamente quedaron 14 datos):

 Como vez.... Eso es lo q necesito q hagan las 2 macros  esta algo complejo vdd? Jejejejej bueno espero q para ti no.... Pq por lo q vi tu si eres un buen programador de macros . Gracias nuevamente y espero me puedas dar una solución a esta gran incognita q eh tenido durante mucho tiempo jejeje.

Cuidate y q estes de lo mejor

Hola buen día Rommsel, primero un millón de disculpas por contestar hasta ahora. Ahí te van las macros que necesitas:

Primera: (igual que la que te había hecho anteriormente, sólo que se ejecuta más rápido), localizate en el primer dato de la lista de tus folios y correla.

Private Sub Repetir_6()
Dim Valor6&, Cont&
Application. ScreenUpdating = False
    Do While ActiveCell. Offset(Cont, 0). Value <> Empty
        With ActiveCell
           . Offset(Cont, -1). Value = Valor6
            If Len(. Offset(Cont, 0). Value) = 6 Then Valor6 = _
               . Offset(Cont, 0). Value:. Offset(Cont, -1). Value = Empty
            Cont = Cont + 1
        End With
    Loop
    Call unicoValor
Application. ScreenUpdating = True
End Sub

Segunda: Igual que la anterior, localizate en la primer fila de la lista y ejecuta la macro, te recomiento colocar tu lista en una hoja nueva para probar estas macros, saludos..

Private Sub unicoValor()
Dim Lista$, ListaFiltrada$
Application. ScreenUpdating = False
    With ActiveCell
        Lista = Range(. Address & ":" &. End(xlDown). Address). Address
            Range(Lista). AdvancedFilter Action:=xlFilterCopy, _
                CopyToRange:=Range(. Offset(0, 4). Address), Unique:=True
            ListaFiltrada = Range(. Offset(0, 4). Address & ":" & _
               . Offset(0, 4). End(xlDown). Address). Address
    End With
For Each celda In Range(ListaFiltrada)
    celda. Offset(0, 1). Value = WorksheetFunction. SumIf(Range(Lista), _
        celda, Range(Range(Lista). Offset(0, 1). Address))
Next
Application. ScreenUpdating = True
End Sub

Hola, quisiera que me ayuden con un temita por favor.
Tengo que hacer una macro de repetición con un Do While o algo por el estilo que me permita de amientras una celda está vacía o que contenga la letra "D" copie un rango determinado (una fila que contiene 6 celdas seguidas), por ejemplo Range( "A1:F1") y la pegue o inserte en la misma hoja pero cambiando de Rango, fila y orden: por ejemplo que la primera celda la copie al final y de la 2da a la 6ta primero.
Lo que estaba haciendo yo es algo así cargando solo los importes en un Listbox:
pero se me complica es al hacer el cambio de renglón como hago para copiar ese renglón y que al saltar de renglón con "ActiveCell. Offset(1, 0). Select" tambien me copie las celdas del renglón siguiente del anterior. Y lo mismo con el lugar donde lo copie donde no debería haber salto de renglón si no se cumpía la condición.
Te pego las columnas para que entiendas mejor, espero que las puedas ver bien.

Range("P18"). Select

Do While ActiveCell <> Empty
If Range("N18") = "D" Then
ListBox1. AddItem Str(ActiveCell)
End If

ActiveCell. Offset(1, 0). Select

Loop

Cacho Rodríguez Capital Federal, Arg...

Escrito por Cacho Rodríguez el 17 de Octubre Hola! Romssel. Una alternativa para tu primera consulta sería la siguiente macro: Sub RepiteLogitud6() Set rng = Range(Selection, Selection. End(xlDown)) rng. Offset(, -1). FormulaR1C1 = "=IF( LEN(RC[1])=6, """", IF( LEN(R[-1]C[1])=6, R[-1]C[1], R[-1]C))" rng. Offset(, -1) = rng. Offset(, -1). Value Set rng = Nothing End Sub Antes de ejecutarla solo tienes que tener seleccionada la celda [B2]: la macro hará el resto desde esa celda hacia abajo. Saludos, Cacho. Responder > Citar  |   Ver mensaje