Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Динохромный


Contributor


Сообщения: 712
Благодарности: 322

Профиль | Отправить PM | Цитировать


Цитата blackeangel:
нужен именно макрос »
blackeangel, могу предложить следующий код с оговорками:
Код должен храниться в рабочей книге, куда вы хотите скопировать данные. Оба файла должны быть открыты, кроме них рабочих книг открывать нельзя. Логика следующая - код будет копировать данные в ту книгу, где хранится он сам, источником он считает вторую открытую книгу.
Заголовки хранятся в строке №1 каждого файла. Столбец с данными для копирования должен иметь номер на единицу больше, чем столбец "№ детали" в файле источнике.
Код
Код: Выделить весь код
Public Sub osn()
    Dim dataBook As Workbook
    Dim dataSheet As Worksheet
    Dim myCell As Range
    Dim i As Integer, j As Integer
    If Application.Workbooks.Count = 2 Then
        For Each dataBook In Application.Workbooks
            If dataBook.Name <> ThisWorkbook.Name Then Set dataSheet = dataBook.ActiveSheet
            
        Next
        i = dataSheet.Rows(1).Find(What:="№ детали", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows).Column
        j = ThisWorkbook.ActiveSheet.Rows(1).Find(What:="Обозначение", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows).Column + 1
        Debug.Print dataSheet.Name
        Debug.Print i & " " & j
        For Each myCell In Intersect(ThisWorkbook.ActiveSheet.UsedRange, ThisWorkbook.ActiveSheet.Columns(j))
            On Error Resume Next
            Err.Clear
            myCell.Value = Application.WorksheetFunction.VLookup(myCell.Offset(0, -1).Value, _
            Range(dataSheet.Cells(1, i), dataSheet.Cells(dataSheet.UsedRange.Count, i + 1)), 2, False)
            If Err.Number <> 0 Then myCell.Value = ""
            
        Next
        ThisWorkbook.ActiveSheet.Cells(1, j).Value = "Инструм."
    Else
        MsgBox "Должно быть открыто 2 файла."
    End If
    Set dataSheet = Nothing
End Sub

Отправлено: 19:42, 30-01-2016 | #6