этот макрос откроет последний сохраненный файл, который начинается с ECL. и будет выполнен поиск в файле ECL определенного значения в этой рабочей тетради на листе: «Основная» ячейка: B3, но я пытаюсь сделать этот макрос для поиска в зависимости от двух критериев, например, в B3 и B4 (я имею в виду, когда два условия подходят ) но я еще не нашел пути. заранее спасибо
Sub Findandkopy()
Dim cellscontents As String
Dim rng As Range
Dim loDeinWert As String
Dim sfirstaddress As String
Dim ESLWb As Workbook
Dim wb As Workbook
Const strPath As String = "L:\10 \05\HGB\"
Dim strFile As String, strFile2Open As String, dteFile As Date, dteLast As Date
strFile = Dir$(strPath & "ECL*.xlsm")
If strFile <> "" Then
Do
dteFile = FileDateTime(strPath & strFile)
If dteFile > dteLast Then
strFile2Open = strFile
dteLast = dteFile
End If
strFile = Dir$
Loop Until strFile = ""
Workbooks.Open strPath & strFile2Open
Else
MsgBox "NO FILES FOUNDED!"
End If
loDeinWert = ThisWorkbook.Worksheets("Main").Range("B3").Value
For Each wb In Application.Workbooks
If wb.Name Like "ECL*" Then
Set ESLWb = wb
Exit For
End If
Next wb
If ESLWb Is Nothing Then
MsgBox "ECL* not found"
Exit Sub
Else
ESLWb.Worksheets("All").Activate
End If
Set rng = ESLWb.Worksheets("All").Range("B:B").Find(loDeinWert)
If rng Is Nothing Then
MsgBox "Wert " & loDeinWert & " not found!"
Else
sfirstaddress = rng.Address
Do
rng.EntireRow.Copy
ThisWorkbook.Worksheets("Main").Cells(Rows.Count, "A").End(xlUp) _
.Offset(1, 0).PasteSpecial Paste:=xlPasteAll
Set rng = ESLWb.Worksheets("Alle").Range("B:B").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> sfirstaddress
End If
ESLWb.Close
End Sub