Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Взаимозависимое копирование ячеек на листах
 
Форумчане, подскажите, пож-та, как можно реализовать посредством VBA следующую задачу:
Что есть:
На лист "Карты" из внешнего источника копируются значения "Карта" и "Имя".
На листе "Коды" есть некий пул номеров под значениями "Код1" и "Код2"
Что необходимо:
При импорте данных на лист "Карты" в поля "Карта" и "Имя", эти параметры должны копироваться в соответствующие поля листа "Коды", откуда в свою очередь должны копироваться поля "Код1" и "Код2".
Оба листа ведутся с постоянным пополнением.

Пример выложил без макроса импорта, главное увидеть сам процесс "взаимного" копирования.

Заранее благодарен.
 
Для такого примера можно как в файле.
Согласие есть продукт при полном непротивлении сторон.
 
Sanja, спасибо за вариант, однако при импорте массива у меня все данные в ячейках будут съезжать, поэтому реализацию хотелось бы увидеть именно посредством VBA.

Update:
Важный нюанс. иногда в лист с кодами значения номера карты и имени будут добавляться вручную. насколько я понял, можно будет использовать формулу =IFERROR(VLOOKUP... но при этом не могу понять, как мне обозначить кодом первую свободную строку в массиве для заполнения на обоих листах.

Буду благодарен за подсказки.
Изменено: VadimVint - 3 Апр 2015 10:35:40
 
как понял ТЗ...
Конь, просто конь.
Удивление есть начало познания © Surprise me!
И да пребудет с нами сила ВПР.
 
Ребята, спасибо за варианты.
Все таки буду благодарен именно за код VBA, так как самый большой пробел именно в части поиска крайней строки.
Зайду с другой стороны :)
Есть код импорта в лист:
Код
Sub CollectAllClients()
Dim BazaWb As Workbook 'текущая книга (общий файл)
Dim BazaSht As Worksheet 'лист База покупателей в общем файле
Dim iTempFileName As String 'имя по-очерёдно открываемого файла
Dim iPath As String 'путь к папке, где лежат все файлы
Dim iLastRowBaza As Long 'последняя заполненная строка в общем файле в столбце A
Dim iLastRowTempWb As Long 'последняя заполненная строка в по-очерёдно открываемом файле в столбце A
Dim iNumFiles As Long 'количество открываемых файлов
Dim LastRow As Long, LastColumn As Integer, i As Long, j As Integer
    Sheets("Общий").UsedRange.Rows.Hidden = False
    Sheets("Общий").UsedRange.Columns.Hidden = False
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlManual
        Set BazaWb = ThisWorkbook
        Set BazaSht = BazaWb.Sheets("Общий")
        iPath = BazaWb.Path & "\"
        iTempFileName = Dir(iPath & "*.xls")
        Do While iTempFileName <> ""
            If iTempFileName <> BazaWb.Name Then
                With .Workbooks.Open _
                     (Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)
                     iNumFiles = iNumFiles + 1
                     'Рабочая книга не должна быть защищена паролем
                     With .Worksheets("Лист1")
                          'номер последней заполенной строки
                          iLastRowTempWb = .Cells(Rows.Count, 1).End(xlUp).Row
                          iLastRowBaza = BazaSht.Cells(Rows.Count, 2).End(xlUp).Row + 1
                          .Range(.Cells(2, 1), .Cells(iLastRowTempWb, 36)).Copy Destination:=BazaSht.Cells(iLastRowBaza, 2)
                     End With
                     .Close SaveChanges:=False
                     Name iPath & iTempFileName As iPath & "Архив\" & iTempFileName
                End With
            End If
            iTempFileName = Dir
        Loop
        .Calculation = xlAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
   MsgBox "Информация собрана из " & iNumFiles & " файлов!", vbInformation, "Конец"
    Range("I:I,K:K,R:R,S:S,T:T,AF:AF,AG:AG,AH:AH,AI:AI,AJ:AJ,AK:AK").Select
    Selection.EntireColumn.Hidden = True
    End Sub


Вот куда тут добавить формулу, чтобы она после вставки массива производила "взаимное" копирование ячеек ума не приложу :(
Приложил файл наиболее близкий по формату к используемому в реале.
Спасибо.
Страницы: 1
Читают тему (гостей: 1)