Hola buenas tardes.

 

Tengo un archivo con el que extraigo información de diferentes hojas del mismo libro a una plantilla llamada contenido.

Yo en la plantilla indico el nombre de la hoja con la que trabajare y de ahí me trae toda la información de datos contenidos en diferentes columnas.

En la columna D17= coloco el No. 1 y en automático inicia el ciclo de poner los datos que se encuentran en las hojas. una vez que termina inicia con el consecutivo 2 y así hasta el último.

El problema que tengo es que me pone un consecutivo más. es decir, si terminara en la 17 se sigue con el 18 o si yo tecleara otro número, vuelve el ciclo.

Pensé en poner un límite en la celda T1 ejemplo=17 (columnas con datos) y así detener el ciclo. 

Lo que necesito es que después de poner el último dato de la última columna de las hojas (Dato) se detenga el consecutivo que pone en la columna D de la hoja de contenido.

creo que mi problema es aquí

 cont = cont + 1   'aumenta mi consecutivo
     Loop
         For ini = 1 To Range("t1")
        Target.Offset(cont - 1, 0).Select
    ActiveCell = Target + 1
            If ini = Target Then Exit For

Espero me puedan ayudar

Gracias

Mariano

 

 

Prueba de consecutivo.xlsm

Prueba y comenta

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim busca As Range
    Dim rg As Range
    Dim cont As Double
    Dim i As Integer

    If InStr(1, Target.Address, ":") = 0 And Not Intersect(Target, Range("D16:D110")) Is Nothing Then
        If Target.Offset(0, 2) = "" Then ' si la columna C esta vacia continuamos
            hoja = Range("W2") ' nombre de la hoja
            L = Split(Sheets(hoja).Cells(4, Columns.Count).End(xlToLeft).Address, "$") ' ultima columna llena
            Set rg = Sheets(hoja).Range("C5:" & L(1) & "4") ' rango de la tabla donde buscar
            'cambie el No 2 por 4 pensando que es la fila
            Set busca = rg.Find(Target, LookIn:=xlValues, LookAt:=xlWhole) ' buscamos en el rango

            If busca Is Nothing Then Exit Sub ' si no lo encuentra sale

            cont = 1

            Do While busca.Offset(cont, 0).Value <> "" ' mientras existan datos en la tabla
                Target.Offset(cont - 1, 3) = busca.Offset(cont, 0) ' columna donde pegara la informacion
                If cont = 1 Then
                    Target.Offset(cont - 1, 3).Font.Bold = True ' negrita
                    Target.Offset(cont - 1, 3).Font.Color = 6567712 ' color azul
                    Target.Offset(cont - 1, 1) = Range("Ag2") 'Chr(149)'coloca el caracter indicado
                    Target.Offset(cont - 1, 1).VerticalAlignment = xlTop ' alinear el simbolo en c arriba
                    'Target.Offset(cont - 1, 25) = Hoja ' nombre de la hoja, para saber de donde viene los datos
                Else
                    Target.Offset(cont - 1, 3).Font.Bold = False ' quita negrita
                    Target.Offset(cont - 1, 3).Font.Color = 0 ' quita color
                    Target.Offset(cont - 1, 20) = "" ' borra coluna C ( donde capturamos la hoja "
                    Target.Offset(cont - 1, 1) = ""
                End If
                cont = cont + 1
            Loop

            For ini = 1 To Range("t1")
                Target.Offset(cont - 1, 0).Select
                If Range("t1") <= Target Then
                    Exit For
                Else
                    ActiveCell = Target + 1
                End If

                With Hoja1
                    vuf = .Range("g" & .Rows.Count).End(xlUp).Row ' cambie la D x E donde copiara ahoara
                    .PageSetup.PrintArea = .Range("e1:r" & vuf).Address(, , , 1)
                End With
                Exit Sub
            Next
        End If
    End If
End Sub