Страницы: 1
RSS
Макрос найти данные в определенной книги из активной книги, и перенести в определенную книгу
 

Здравствуйте знатоки, помогите пожалуйста мне с такой проблемой. У меня есть книга "База данных" в которой хранится информация, и есть книга "Отправка" в которую я вношу информацию, чтобы отправить ее в книгу "База данных", но вот, что нужно. А нужно, чтобы макрос брал информацию из книги "Отправка", лист "Инф", ячейка "A8", и искал её в книги "База данных" в столбце (A:A), если нашел то он должен копировать с заменой ячейки из книги "Отправка", лист "Инф", ячейка "A8:L8",  в книгу "База данных". Например, если он нашел информацию в книги "База данных" в столбце (A:A), ячейка "A197", то он копирует информацию  из книги "Отправка", лист "Инф", ячейка "A8:L8",  в книгу "База данных" в ячейки "A197:L197". В Excel полный ноль, поэтому прошу Вас помочь, просто информации много а вручную делать долго и сложно, а сроки поджимают

 
Код
Sub УшлаНаБазу()
    Dim shI As Worksheet: Set shI = Workbooks("Отправка.xlsm").Worksheets("Инф")
    Dim shZ As Worksheet: Set shZ = Workbooks("База данных.xlsm").Worksheets("Заявки")
    
    Dim a As Variant
    a = shI.Range("A8:J8")
    
    Dim y As Long
    If a(1, 1) <> "" Then
        On Error Resume Next
            y = WorksheetFunction.Match(a(1, 1), shZ.Columns(1), 0)
        On Error GoTo 0
    End If
    
    If y > 0 Then
        shZ.Cells(y, 1).Resize(1, UBound(a, 2)).Value = a
    End If
End Sub
 
Подскажите а где прописать путь к файлу "База данных". Ругается вот на это
Код
Set shZ = Workbooks("База данных.xlsm").Worksheets("Заявки")
Изменено: Lerik2020 - 16.01.2020 15:28:34
 
Обе книги должны быть открыты
 
А можно чтобы книга "База данных" была закрыта? Я где то видел на форумах знести данные в закрытую книгу
Изменено: Lerik2020 - 16.01.2020 15:36:35
 
В вашем случае книгу необходимо открыть.
"Все гениальное просто, а все простое гениально!!!"
 
А для случая чтобы книга "База данных" была закрыта можете помочь. Просто с книгой "База данных" будут работать несколько человек для ускорения работы
 
Код
Const DB_FULLNAME = "C:\tmp\База данных.xlsm"

Sub УшлаНаБазу()
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim sName As String
    sName = fso.getfilename(DB_FULLNAME)
    
    Dim bClose As Boolean
    Dim wb As Workbook
    On Error Resume Next
        Set wb = Workbooks(sName)
    On Error GoTo 0
    If wb Is Nothing Then
        Set wb = Workbooks.Open(DB_FULLNAME, False, False)
        bClose = True
    End If
    
    Dim shI As Worksheet: Set shI = Workbooks("Отправка.xlsm").Worksheets("Инф")
    Dim shZ As Worksheet: Set shZ = wb.Worksheets("Заявки")
     
    Dim a As Variant
    a = shI.Range("A8:J8")
     
    Dim y As Long
    If a(1, 1) <> "" Then
        On Error Resume Next
            y = WorksheetFunction.Match(a(1, 1), shZ.Columns(1), 0)
        On Error GoTo 0
    End If
     
    If y > 0 Then
        shZ.Cells(y, 1).Resize(1, UBound(a, 2)).Value = a
    End If
    
    If bClose Then
        Application.DisplayAlerts = False
        wb.Close True
        Application.DisplayAlerts = True
    End If
End Sub
 
Спасибо большое дай Бог Вам здоровья!!!
 
МатросНаЗебре Подскажите, а можно сделать, так чтобы макрос делала тоже самое, но копировал не диапазон, а конкретные ячейки, например "A8", "D8", "G8", "K8", "M8". Забыл про такой момент , что данные не только должны заменятся но еще и добавляться.
Страницы: 1
Читают тему (гостей: 1)
Наверх