Макрос для сравнения данных ячеек одной книги с другой - VBA

Формулировка задачи:

Здравствуйте! Пожалуйста, не ругайтесь, я новенький. У меня стоит задача автоматизации отчета по дням. Во вложении я привел данные, с которыми нужно работать. Суть задачи такова, что нужно проверить из Книга2 каждую ячейку первого столбца со всеми ячейками первого столбца из Книга1, и если совпадет, нужно вставить данные ячейки этой же строки второго столбца в найденную строку из Книга1 того столбца, даты которых совпадают (даты прописаны в первой стоке Книга1, а в файле Книга2 в ячейку B3) Заранее благодарен за помощь.Книга1.xlsxКнига2.xlsx

Решение задачи: «Макрос для сравнения данных ячеек одной книги с другой»

textual
                            Листинг программы 
                        
 
                            
                        
Option Base 1
 
Sub qweqwe()
Dim Twb As Workbook
Dim Arr, Arr2
Dim Wb As Workbook
Dim Da As Date
Dim s As Long, sC%, jDa%
Dim FName$
 
 
Application.ScreenUpdating = False
 
Set Twb = ThisWorkbook
s = Twb.Sheets(1).Cells(1, 1).End(xlDown).Row
sC = Twb.Sheets(1).Cells(1, 3).End(xlToRight).Column
Arr = Range(Twb.Sheets(1).Cells(1, 1), Twb.Sheets(1).Cells(s, 1))
 
FName = GetFilePath(, Twb.Path)
If FName = "" Then Exit Sub
Set Wb = Workbooks.Open(FName)
 
s = Wb.Sheets(1).Cells(4, 1).End(xlDown).Row
Arr2 = Range(Wb.Sheets(1).Cells(5, 1), Wb.Sheets(1).Cells(s, 2))
Da = Wb.Sheets(1).Cells(3, 2)
For j = 3 To sC
    If CDate(Twb.Sheets(1).Cells(1, j)) = Da Then jDa = j: Exit For
Next j
 
Wb.Close False
 
For i = 3 To UBound(Arr)
    For j = 1 To UBound(Arr2)
        If Arr(i, 1) = Arr2(j, 1) Then
            Twb.Sheets(1).Cells(i, jDa) = Arr2(j, 2)
        End If
    Next j
Next i
 
 
End Sub
 
 
Function GetFilePath(Optional ByVal Title As String = "Выберите файл для обработки", _
                      Optional ByVal InitialPath As String = "", _
                      Optional ByVal FilterDescription As String = "Книги Excel", _
                      Optional ByVal FilterExtention As String = "*.xlsx*") As String
    On Error Resume Next
     With Application.FileDialog(msoFileDialogOpen)
         .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
         .Filters.Clear: .Filters.Add FilterDescription, FilterExtention
         If .Show <> -1 Then Exit Function
         GetFilePath = .SelectedItems(1): PS = Application.PathSeparator
     End With
 End Function