Sub Copy2File() ' срабатывает при нажатии одной из кнопок в подменю
On Error Resume Next
ПутьКФайлу = Application.CommandBars.ActionControl.Tag
'MsgBox "Параметр макроса = """ & ПутьКФайлу & """", vbInformation, "Запущен макрос из подменю"
Application.ScreenUpdating = False
Dim ro As Range: Set ro = Intersect(Selection.EntireColumn, Selection.EntireColumn, ActiveSheet.UsedRange)
Dim pi As New ProgressIndicator
pi.Show "Перенос выделенных строк в файл"
pi.StartNewAction , 30, "Открытие файла ...", "Файл: " & ПутьКФайлу
Dim wb As Workbook: Set wb = GetObject(ПутьКФайлу)
pi.StartNewAction 30, 50, "Запись данных ...", " "
Dim cell As Range: Set cell = wb.Worksheets(1).Range("a" & wb.Worksheets(1).Rows.Count).End(xlUp).Offset(1)
ro.Copy cell
wb.Windows(1).Visible = True
pi.StartNewAction 50, 100, "Сохранение файла ...", "Файл: " & ПутьКФайлу
wb.Close True
pi.Hide
End Sub