Sub ИзДругойКниги1()
    Dim WB As Workbook
    Set WB = GetAnotherWorkbook 
    If Not WB Is Nothing Then         
        WB.Worksheets(1).Range("C11:G38").Copy ThisWorkbook.ActiveSheet.Range("C11")              
        WB.Worksheets(1).Range("D1").Copy
   ThisWorkbook.ActiveSheet.Range("C2").PasteSpecial Paste:=xlPasteValues         
        WB.Close False
    End If     
End Sub
  'Это я пытался сделать
   'If WB.GetFileName Like "*ИП*.xlsx*" Then
   'WB.Worksheets(1).Range("C5:E5").Copy ThisWorkbook.ActiveSheet.Range("F3:H3")
   'Else
   ' WB.Worksheets(1).Range("F3:H3").Copy ThisWorkbook.ActiveSheet.Range("F3:H3")
   ' End If

Sub Logo_Fill() ' Работает для ячейки
    Dim pic As Picture
    Sheets("Whatsapp").Unprotect
    For Each pic In Sheets("Whatsapp").Pictures
        If Not Application.Intersect(pic.TopLeftCell, Range("H6")) Is Nothing Then
           MsgBox "Рисунок есть в H6"
           Else
        MsgBox "Нет рисунка в H6"
 'Exit Sub
        End If
    Next pic
End Sub

Sub ПеренесстиВОтчетИП()

Dim firstBook As Workbook
Dim secondBook As Workbook
Set firstBook = ThisWorkbook
Set secondBook = ActiveWorkbook

On Error Resume Next
Application.ScreenUpdating = False
Set firstBook = Workbooks.Open("C:\Users\Владимир\Desktop\Отчет.xlsb")
 'Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "Отчет.xlsb") ' Пр
Row = 2
    Do While secondBook.Worksheets("Отчет").Cells(Row, 2).Value <> 0
        Row = Row + 1
    Loop
  lLastRow = Cells(1, 2).End(xlDown).Row
    secondBook.Worksheets("Отчет").Cells(Row, 2).Value = firstBook.Worksheets("Лист1").Cells(8, 4).Value + 0 'Номер Тов чек
    secondBook.Worksheets("Отчет").Cells(Row, 3).Value = firstBook.Worksheets("Лист1").Cells(9, 7).Value 'Дата
   
    secondBook.Worksheets("Отчет").Cells(Row, 1).Value = firstBook.Worksheets("Лист1").Cells(38, 5).Value 'Клиент'
    secondBook.Worksheets("Отчет").Cells(Row, 4).Value = firstBook.Worksheets("Лист1").Cells(39, 5).Value 'Адрес
    secondBook.Worksheets("Отчет").Cells(Row, 7).Value = firstBook.Worksheets("Лист1").Cells(40, 5).Value 'Договор
   
    secondBook.Worksheets("Отчет").Cells(Row, 6).Value = firstBook.Worksheets("Лист1").Cells(59, 7).Value 'Товар или работы. Через доп ячейку

Application.ScreenUpdating = True
End Sub

Sub Обновить()
    Dim ar, arT, ar1
    Dim i&, j&
    Dim wb As Workbook, sh As Worksheet
    Application.ScreenUpdating = False
    ar = Range(Cells(2, "A"), Cells(Rows.Count, "A").End(xlUp)).Value
    ReDim ar1(1 To UBound(ar), 1 To 2)
Set sh = Sheets("Лист2")
        arT = sh.Range(sh.Cells(2, "M"), sh.Cells(sh.Rows.Count, "A").End(xlUp)).Value
        For i = 1 To UBound(ar)
            For j = 1 To UBound(arT)
                If ar(i, 1) = arT(j, 1) Then
                    ar1(i, 1) = arT(j, 13)
                End If
            Next
        Next
    Set sh = Sheets("Лист3")
        arT = sh.Range(sh.Cells(2, "K"), sh.Cells(sh.Rows.Count, "A").End(xlUp)).Value
        For i = 1 To UBound(ar)
            For j = 1 To UBound(arT)
                If ar(i, 1) = arT(j, 1) Then
                    ar1(i, 1) = arT(j, 11)
                End If
            Next
        Next
    Range("C2").Resize(UBound(ar1), 1) = ar1
End Sub

Sub Макрос1()
    Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 4), TrailingMinusNumbers:=True
End Sub

Sub DateCorrect()
    Dim r As Long
    For r = 1 To Cells(Rows.Count, 2).End(xlUp).Row
        If Cells(r, 2) Like "##.##.####" Then
            Cells(r, 2) = DateSerial(Right(Cells(r, 2), 4), Mid(Cells(r, 2), 4, 2), Left(Cells(r, 2), 2))
            Cells(r, 2).NumberFormat = "dd.mm.yy;@"
        End If
    Next r
End Sub