Adicionar línea a macro para limitar extracción

Seria posible adicionar una línea que indique hasta que columna debe leer la macro que ud. Creo.

Anexo macro:


Sub Importar_Datos()
'
'    Por.Dante Amor
'
    '
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Valores")
    Set h2 = l1.Sheets("Resumen")
    h2.Cells.ClearContents
    '
    ruta = h1.[B5]
    hoja = h1.[B6]
    fila = h1.[B7]
    colu = h1.[B8]
    '
    mensaje = validaciones(ruta, hoja, fila, colu)
    If mensaje <> "" Then
        MsgBox mensaje, vbExclamation, "IMPORTAR ARCHIVOS"
        Exit Sub
    End If
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.StatusBar = False
    Application.Calculation = xlCalculationManual
    '
    If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
    arch = Dir(ruta & "*.xls*")
    i = 0
    Do While arch <> ""
        i = i + 1
        Application.StatusBar = "Importando Libro : " & i & " de : " & n
        Set l2 = Workbooks.Open(ruta & arch)
        existe = False
        If IsNumeric(hoja) Then
            If l2.Sheets.Count >= hoja Then
                existe = True
                Set h22 = l2.Sheets(hoja)
            Else
            End If
        Else
            For Each h In l2.Sheets
                If LCase(h.Name) = LCase(hoja) Then
                    existe = True
                    Set h22 = l2.Sheets(hoja)
                    Exit For
                End If
            Next
        End If
        '
        If existe Then
            u22 = h22.Range(colu & Rows.Count).End(xlUp).Row
            u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
            h22.Rows(fila & ":" & u22).Copy
            h2.Range("A" & u2).PasteSpecial xlValues
        End If
        '
        l2.Close False
        arch = Dir()
    Loop
    '
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    '
    MsgBox "Proceso terminado, archivos importados a la hoja resumen", vbInformation, "IMPORTAR ARCHIVOS"
End Sub

Añade tu respuesta

Haz clic para o