1 Sub copy_date() 2 Dim i&, sh As Worksheet, iCell As Range, iDate As Date, lsRow& 3 Set sh = ThisWorkbook.Sheets("15 äíåé äî îêîí÷àíèÿ") 4 iDate = Date + 15 5 For i = 1 To ThisWorkbook.Sheets.Count 6 If Sheets(i).Name = "Äîãîâîðà" Then 7 With Sheets(i) 8 For Each iCell In .Range("K3:K" & .Cells(Rows.Count, "K").End(xlUp).Row) 9 If ((iCell <= iDate) And (iCell >= Date)) Then lsRow = sh.Cells(Rows.Count, "K").End(xlUp).Row + 1: _ 10 .Range("A" & iCell.Row & ":K" & iCell.Row).Copy Destination:=sh.Range("A" & lsRow) 11 Next iCell 12 End With 13 End If 14 Next i 15 End Sub
[/vba]
в строке 8 выдает icell=Error 2042
сам макрос выдает ошибку run time error 13
[vba]
Код
1 Sub copy_date() 2 Dim i&, sh As Worksheet, iCell As Range, iDate As Date, lsRow& 3 Set sh = ThisWorkbook.Sheets("15 äíåé äî îêîí÷àíèÿ") 4 iDate = Date + 15 5 For i = 1 To ThisWorkbook.Sheets.Count 6 If Sheets(i).Name = "Äîãîâîðà" Then 7 With Sheets(i) 8 For Each iCell In .Range("K3:K" & .Cells(Rows.Count, "K").End(xlUp).Row) 9 If ((iCell <= iDate) And (iCell >= Date)) Then lsRow = sh.Cells(Rows.Count, "K").End(xlUp).Row + 1: _ 10 .Range("A" & iCell.Row & ":K" & iCell.Row).Copy Destination:=sh.Range("A" & lsRow) 11 Next iCell 12 End With 13 End If 14 Next i 15 End Sub
исходный файл в который макрос впихнут большой не удовлетворяет требованию, а в чистовом варианте с небольшим количеством данных макрос работает. макрос делает выборку по дате удовлетворяющим условию и выводит соответствующие строки в отдельный лист
исходный файл в который макрос впихнут большой не удовлетворяет требованию, а в чистовом варианте с небольшим количеством данных макрос работает. макрос делает выборку по дате удовлетворяющим условию и выводит соответствующие строки в отдельный листregitr