Добрый день. Есть файл, в который нужно вписывать все заказы по месяцам. Каждый месяц - отдельный лист с наименованием месяца. Заказы постоянно изменяются. За какие-то приходит оплата, какие-то отменились и так далее. В зависимости от этого макрос при оплате окрашивает определенные ячейки в другой цвет, если оплаты не поступило, то наоборот убирает окраску.
Но суть не в этом. При запуске макроса нужно выбрать файл. Макрос ищет первую пустую ячейку, смещается от нее на 1 вниз и с этого места начинает записывать заказы по строчками и месяцам. Нужно сделать так, чтобы на каждом отдельном листе (месяце) он начинал записывать заказы с определенной строчки. В моем случае с пятой строчки. Вот сам макрос:
Sub Выгрузка_заказов()
Dim file As String, arr(), sh As Worksheet, i As Long, lr As Long
file = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор сводного файла")
If file = "false" Then Exit Sub
Application.ScreenUpdating = False
arr = GetObject(file).ActiveSheet.UsedRange.Value
GetObject(file).Close False
For Each sh In Worksheets
With Sheets(sh.Name)
lr = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 ' начальное смещение
For i = 3 To UBound(arr) ' вот теперь поехали!
If sh.Name = Format(arr(i, 2), "MMMM") Then ' тот ли лист
.Cells(lr + 1, 1) = arr(i, 1)
.Cells(lr + 1, 2) = arr(i, 2)
.Cells(lr + 1, 3) = arr(i, 6)
.Cells(lr + 1, 4) = arr(i, 7)
.Cells(lr + 1, 5) = arr(i, 8)
.Cells(lr + 1, 6) = arr(i, 11)
.Cells(lr + 1, 7) = arr(i, 14)
.Cells(lr + 1, 8) = arr(i, 17)
.Cells(lr + 1, 18) = arr(i, 9)
.Cells(lr + 1, 19) = arr(i, 18)
If arr(i, 18) > 0 Then
.Cells(lr + 1, 19) = arr(i, 18)
End If
If arr(i, 21) = "Оплачено" Then
.Cells(lr + 1, 7).Interior.ColorIndex = 4 'зеленый
Else
.Cells(lr + 1, 7).Interior.ColorIndex = 0 'Никакой
End If
If arr(i, 22) = "Оплачено" Then
.Cells(lr + 1, 8).Interior.ColorIndex = 4 'зеленый
Else
.Cells(lr + 1, 8).Interior.ColorIndex = 0 'Никакой
End If
If arr(i, 23) = "Оплачено" Then
.Cells(lr + 1, 19).Interior.ColorIndex = 6 'зеленый
Else
.Cells(lr + 1, 19).Interior.ColorIndex = 0 'Никакой
End If
lr = lr + 1 ' сдвигаемся
End If
Next
End With
Next
Application.ScreenUpdating = True
End Sub
Нужно изменить видимо вот эту строчку:
lr = .Cells(.Rows.Count, 1).End(xlUp).Row + 1