Страницы: 1
RSS
Ошибка "type mismatch"
 
Народ, добрый день всем.
В кое-то веки сам смог написать код работающий под загрузку данных (был для одного файла - как пробник). Решил сделать аналогичную операцию для ряда похожих файлов, чтобы выбирал пути и подгружал данные циклом. То есть, цикл должен по моей задумке пройтись по некоторым ячейкам в столбце последовательно, где указаны пути к папкам.
Начала вылезать ошибка "type mismatch" error 13. Подскажите плиз, что не так... Дебажит на строку цикла For.
Всем добра!
Код
Sub Consolidate()      'Макрос открытия файла
Dim wb As Workbook
Dim rc&, rn&, i As Long
Application.ScreenUpdating = False
'rn = Sheets("1").Cells(2, 12)
rc = Sheets("1").Cells(Rows.Count, 12).End(xlUp).Row
i = i + 1
For a = Sheets("1").Cells(i, 12) To rc
    FilePath = Sheets("1").Cells(i, 12).Value
    Workbooks.Open Filename:=FilePath
    Sheets("1_Портфель привлечений").Select
    Range("A6:E9").Select
    Selection.Copy
    Workbooks("Проба.xlsm").Activate
    ActiveWorkbook.Sheets("2").Select
    lLastrow = Cells(Rows.Count, 1).End(xlUp).Row
    Set R = ActiveWorkbook.Sheets("2").Cells(lLastrow + 1, 1)
    R.Select
    Selection.PasteSpecial Paste:=xlPasteValues
    For Each wb In Workbooks    ' перебираем все открытые книги
        If Not wb Is ActiveWorkbook Then    ' если это не этот файл
           If wb.Windows(1).Visible Then wb.Close False  ' закрываем его
        End If
    Next wb
Next
Application.ScreenUpdating = True
End Sub
 
Что в Sheets("1").Cells(i, 12)?
Даже вернее так - Что в Sheets("1").Cells(1, 12)?
Изменено: Hugo - 20.03.2018 11:19:56
 
Код
.value
 
Вообще код нужно весь переписывать, там всё нелогично и неправильно...
 
Hugo,
Планирую там начинать цикл (первая ячейка в столбце, где расположен путь к файлу)
Кстати говоря, похоже понял свою ошибку. В корне цикл не так задал.
Я правильно ведь понимаю, что нужно было объявить обычный:
For i=2 To по "последнее заполненное значение в столбце"
      И что-то типа Cells(i,12)?
 
Откудаж нам знать Ваши желания? :)
 
Hugo,
Согласен, неоткуда)))
Но все же, почему вылетает ошибка?
 
Написал сейчас так. Ошибки нет, но код перестал работать(
Код
Sub Consolidate()      'Макрос открытия файла
Dim wb As Workbook
Dim rc&, rn&, i As Long
Application.ScreenUpdating = False
'rn = Sheets("1").Cells(2, 12)
rc = Sheets("1").Cells(Rows.Count, 12).End(xlUp).Row
lLastrow1 = Cells(Rows.Count, 12).End(xlUp).Row
For i = 2 To lLastrow1
    FilePath = Sheets("1").Cells(i, 12).Value
    Workbooks.Open Filename:=FilePath
    Sheets("1_Портфель привлечений").Select
    Range("A6:E9").Select
    Selection.Copy
    Workbooks("Проба.xlsm").Activate
    ActiveWorkbook.Sheets("2").Select
    lLastrow2 = Cells(Rows.Count, 1).End(xlUp).Row
    Set R = ActiveWorkbook.Sheets("2").Cells(lLastrow2 + 1, 1)
    R.Select
    Selection.PasteSpecial Paste:=xlPasteValues
    For Each wb In Workbooks    ' перебираем все открытые книги
        If Not wb Is ActiveWorkbook Then    ' если это не этот файл
           If wb.Windows(1).Visible Then wb.Close False  ' закрываем его
        End If
    Next wb
Next
Application.ScreenUpdating = True
End Sub

Изменено: vadik-ceo - 20.03.2018 11:33:05
 
Цитата
vadik-ceo написал:
Но все же, почему вылетает ошибка?
- если бы попытались ответить на мой вопрос, может и сами бы поняли.
 
Название темы.  Вы даже не представляете, во что может превратиться тема, после того, как сюда начнут вались все вопросы по этой ошибке.
Цитата
Hugo написал: Откудаж нам знать Ваши желания?
 
Все работает как часы)
Код
Sub Consolidate()      'Макрос открытия файла
Dim wb As Workbook
Dim rc&, rn&, lLastrow1 As Long
Application.ScreenUpdating = False
lLastrow1 = Sheets("1").Cells(Rows.Count, 12).End(xlUp).Row
For i = 2 To lLastrow1
    FilePath = Sheets("1").Cells(i, 12).Value
    Workbooks.Open Filename:=FilePath
    Sheets("1_Портфель привлечений").Select
    Range("A6:E9").Select
    Selection.Copy
    Workbooks("Проба.xlsm").Activate
    ActiveWorkbook.Sheets("2").Select
    lLastrow2 = Cells(Rows.Count, 1).End(xlUp).Row
    Set R = ActiveWorkbook.Sheets("2").Cells(lLastrow2 + 1, 1)
    R.Select
    Selection.PasteSpecial Paste:=xlPasteValues
    For Each wb In Workbooks    ' перебираем все открытые книги
        If Not wb Is ActiveWorkbook Then    ' если это не этот файл
           If wb.Windows(1).Visible Then wb.Close False  ' закрываем его
        End If
    Next wb
Next
Application.ScreenUpdating = True
End Sub

    Next wb
Next
Application.ScreenUpdating = True
End Sub

Изменено: vadik-ceo - 20.03.2018 11:48:59
 
До швейцарских часов еще ой как далеко :)
В коде много лишнего.
 
vikttur,
Не спорю) Но для меня, как человека три дня назад севшего писать свой третий макрос - это гений чистой красоты))
 
Поэтому и предлагается: предложить название темы, отражающее суть задачи. Модераторы заменят. Помощники постараются сделать Ваши часы качественнее
 
vadik-ceo, Select и Activate можно заменить прямыми ссылками на листы/диапазоны.
 
Цитата
vadik-ceo написал: три дня назад севшего писать свой третий макрос
У Вас план - в день по макросу? :)
 
vikttur,
Ахах) Да, примерно так))
Anchoret,
Спасибо большое за совет, буду дорабатывать!
 
Так Вы предложите название темы? Это не шутка, это требование не нарушать правила форума
Уже начали поступать предложения по оптимизации, но скрыты и больше никакие предложения не принимаются.
Страницы: 1
Наверх