Здравствуйте. Имеется макрос который должен копировать и переносить данные в отдельный файлик, только копирует и формулу. пробовал добавить value, но моя не писатель поэтому прошу совета здесь и еще как бы добавить условие чтоб удалялись строки с отрицательным значением
[vba]
Код
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
[/vba]
Здравствуйте. Имеется макрос который должен копировать и переносить данные в отдельный файлик, только копирует и формулу. пробовал добавить value, но моя не писатель поэтому прошу совета здесь и еще как бы добавить условие чтоб удалялись строки с отрицательным значением
[vba]
Код
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