Импорт данных в динамический диапазон

[LaktAV]

Здравствуйте. Прошу помощи с макросами.

Исходные данные. Есть файл расчета и 2 файла-донора, из которых по мере необходимости импортируются данные из определенных диапазонов в назначенный диапазон расчетного файла. Структуры файлов-доноров различаются, поэтому макросов два.
Задача. Сейчас диапазон для вставки необходимых данных прописан в расчетном файле фиксировано. НО! Количество строк для импорта всегда различно и не обязательно равно диапазону в расчетном файле. Необходимо скорректировать коды макросов таким образом, чтобы перед импортом данных проходила проверка и подсчет количества строк с данными. И копировалось именно необходимое количество. Остальные строки в указанном диапазоне расчетного файла не затрагивались и исходные значения в них не изменялись. Надеюсь, более-менее доступно объяснил суть.
П.С. макросы писал не сам, а нашел в сети, немного доработал для своих нужд.

Ниже привожу коды макросов. Их два. Первый - для файла-донора SupplierPositions, второй - для Экспорт потребностей закупки (Export of procurement requirements). Заранее спасибо за помощь.

Код Выделить Развернуть

Sub CopyPast_ETPGPB()
    Dim oFD As FileDialog, wb As Workbook
    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    With oFD
        .AllowMultiSelect = False
       ' .Title = ""
        .Filters.Clear
        .Filters.Add "All files", "*.*"
        .InitialFileName = ActiveWorkbook.Path
        .InitialView = msoFileDialogViewDetails
        If oFD.Show = 0 Then Exit Sub
    End With
    Application.ScreenUpdating = False
    Path = oFD.SelectedItems(1)
    Workbooks.Open (Path)
    Set wb = ActiveWorkbook
    ThisWorkbook.Worksheets("Потребность для загрузки").Activate
    'Экспорт кода позиции
    ThisWorkbook.Worksheets("Потребность для загрузки").Range("D4:D103").Value = wb.Worksheets("Worksheet").Range("G3:G103").Value
    'Экспорт наименования позиции
    ThisWorkbook.Worksheets("Потребность для загрузки").Range("E4:E103").Value = wb.Worksheets("Worksheet").Range("B3:B103").Value
    'Экспорт описания запроса/комментария заказчика
    ThisWorkbook.Worksheets("Потребность для загрузки").Range("F4:F103").Value = wb.Worksheets("Worksheet").Range("D3:D103").Value
    'Экспорт ЕИ
    ThisWorkbook.Worksheets("Потребность для загрузки").Range("K4:K103").Value = wb.Worksheets("Worksheet").Range("J3:J103").Value
    'Экспорт количества
    ThisWorkbook.Worksheets("Потребность для загрузки").Range("J4:J103").Value = wb.Worksheets("Worksheet").Range("K3:K103").Value
    'Экспорт типа, марки, артикула
    ThisWorkbook.Worksheets("Потребность для загрузки").Range("G4:G103").Value = wb.Worksheets("Worksheet").Range("L3:L103").Value
    'Экспорт производителя
    ThisWorkbook.Worksheets("Потребность для загрузки").Range("H4:H103").Value = wb.Worksheets("Worksheet").Range("M3:M103").Value
    'Экспорт максимальной цены за ед. без НДС
    ThisWorkbook.Worksheets("Потребность для загрузки").Range("L4:L103").Value = wb.Worksheets("Worksheet").Range("T3:T103").Value
    wb.Close
    CarryOn = MsgBox("Данные успешно импортированы", vbOKOnly + vbInformation, "Уведомление")
End Sub

Код Выделить Развернуть

Sub CopyPast_Lahta()
    Dim oFD As FileDialog, wb As Workbook
    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    With oFD
        .AllowMultiSelect = False
       ' .Title = ""
        .Filters.Clear
        .Filters.Add "All files", "*.*"
        .InitialFileName = ActiveWorkbook.Path
        .InitialView = msoFileDialogViewDetails
        If oFD.Show = 0 Then Exit Sub
    End With
    Application.ScreenUpdating = False
    Path = oFD.SelectedItems(1)
    Workbooks.Open (Path)
    Set wb = ActiveWorkbook
    ThisWorkbook.Worksheets("Потребность для загрузки").Activate
    
    'Экспорт кода позиции
    ThisWorkbook.Worksheets("Потребность для загрузки").Range("D4:D103").Value = wb.Worksheets("Потребности (Requirements)").Range("D2:D103").Value
    'Экспорт наименования позиции
    ThisWorkbook.Worksheets("Потребность для загрузки").Range("E4:E103").Value = wb.Worksheets("Потребности (Requirements)").Range("E2:E103").Value
    'Экспорт количества
    ThisWorkbook.Worksheets("Потребность для загрузки").Range("J4:J103").Value = wb.Worksheets("Потребности (Requirements)").Range("H2:H103").Value
    'Экспорт типа, марки, артикула
    ThisWorkbook.Worksheets("Потребность для загрузки").Range("G4:G103").Value = wb.Worksheets("Потребности (Requirements)").Range("K2:K103").Value
    'Экспорт производителя
    ThisWorkbook.Worksheets("Потребность для загрузки").Range("H4:H103").Value = wb.Worksheets("Потребности (Requirements)").Range("R2:R103").Value
    'Экспорт цены за ед. без НДС
    ThisWorkbook.Worksheets("Потребность для загрузки").Range("L4:L103").Value = wb.Worksheets("Потребности (Requirements)").Range("W2:W103").Value
    'Экспорт крайней даты поставки
    ThisWorkbook.Worksheets("Легенда").Range("M19").Value = wb.Worksheets("Потребности (Requirements)").Range("F2").Value
    wb.Close
    CarryOn = MsgBox("Данные успешно импортированы", vbOKOnly + vbInformation, "Уведомление")
End Sub

[Serge 007]

Кросс: http://www.excelworld.ru/forum/10-52506-1

[Serge 007]

Здравствуйте

Вникать в три файла и чужие макросы особого желания нет (судя по количеству ответов не только у меня), а вот помочь решить вопрос темы -

что бы перед импортом данных проходила проверка и подсчет количества строк с данными. И копировалось именно необходимое количество

- пожалуйста

Вот простой макрос, который определяет количество заполненных строк и копирует только их:

Код Выделить Развернуть

Sub LaktAV()
    Dim LR&
    LR = Cells(Rows.Count, 1).End(xlUp).Row 'Определяем последнюю строку диапазона в столбце А
    Range("a1:a" & LR).Copy 'Копируем заполненный диапазон
    ActiveSheet.Paste [c1] 'Вставляем ранее скопированное в столбец С, начиная с первой строки
End Sub