Добрый день!
В макросах новичок, второй день разбираюсь.
Подскажите пожалуйста.
Есть макрос который из одного файла переносит информацию в другой файл.
Другой файл называется "Система прогнозирования свободных остатков_пробный.xlsm"
Если этот файл открыт, то данные переносятся, если файл закрыт, то данные не переносятся и выходит ошибка subscript out of range
Ниже макрос
Код |
---|
Dim sbor As Range
Sub PerenosSbor()
Dim lStart As Long, lEnd As Long, lLastRow As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Workbooks("Система прогнозирования свободных остатков_пробный.xlsm").Save
Application.Wait (Now + TimeValue("0:00:3"))
'1. Определение первой ячейки с данными в столбце "A".
'After:=Cells(Rows.Count, "A") указывает, с какой ячейки начать поиск.
'Если не указывать, то поиск ведётся с ячейки "A1" и первой просматриватся
'ячейка "A2". Если данные уже есть в ячейке "A1", то результат
'будет неправильным. Поэтому нужно указать ячейку, с которой начинается поиск.
lStart = Columns("A").Find(What:="?", After:=Cells(1, "A"), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row
'2. Определение последней ячейки с данными в столбце "A".
lEnd = Columns("A").Find(What:="?", LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
MatchCase:=False, SearchFormat:=False).Row
'3. Выделение диапазона с данными в столбце "A".
Set sbor = Range("A" & lStart & ":G" & lEnd)
With Workbooks("Система прогнозирования свободных остатков_пробный.xlsm").Worksheets("1.СБОР")
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
On Error Resume Next
.ShowAllData
sbor.Copy
.Range("A" & lLastRow).PasteSpecial xlPasteValuesAndNumberFormats
End With
Workbooks("Система прогнозирования свободных остатков_пробный.xlsm").Save
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub |