Здравствуйте уважаемые форумчане. Суть проблемы в следующем: есть макрос, который копирует данные на другой лист со всеми формулами, а надо, как значение. Пробовала внедрить в него PasteSpecial Paste:=xlPasteValues, не получилось, не подскажите как? Вот сам макрос: [vba]
Код
Sub Perenos() Dim LastRow As Long, Rw As Long LastRow = Cells(Rows.Count, 1).End(xlUp).Row With Sheets("Архив") Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1 For i = 2 To LastRow If Cells(i, 7) = "1" Then Application.ScreenUpdating = False Range(Cells(i, 1), Cells(i, 6)).Copy .Cells(Rw, 1) Rw = Rw + 1 End If Next End With Range("B3:F11").ClearContents Range("B3").Activate MsgBox "Перенос выполнен!", 64, "" Application.ScreenUpdating = True End Sub
[/vba]
Здравствуйте уважаемые форумчане. Суть проблемы в следующем: есть макрос, который копирует данные на другой лист со всеми формулами, а надо, как значение. Пробовала внедрить в него PasteSpecial Paste:=xlPasteValues, не получилось, не подскажите как? Вот сам макрос: [vba]
Код
Sub Perenos() Dim LastRow As Long, Rw As Long LastRow = Cells(Rows.Count, 1).End(xlUp).Row With Sheets("Архив") Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1 For i = 2 To LastRow If Cells(i, 7) = "1" Then Application.ScreenUpdating = False Range(Cells(i, 1), Cells(i, 6)).Copy .Cells(Rw, 1) Rw = Rw + 1 End If Next End With Range("B3:F11").ClearContents Range("B3").Activate MsgBox "Перенос выполнен!", 64, "" Application.ScreenUpdating = True End Sub
Sub Perenos() Dim LastRow As Long, Rw As Long Application.ScreenUpdating = False LastRow = Cells(Rows.Count, 1).End(xlUp).Row With Sheets("Архив") Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1 For i = 2 To LastRow If Cells(i, 7) = "1" Then Range(Cells(i, 1), Cells(i, 6)).Copy .Cells(Rw, 1).PasteSpecial xlPasteValues Rw = Rw + 1 End If Next End With Range("B3:F11").ClearContents Range("B3").Activate MsgBox "Перенос выполнен!", 64, "" Application.ScreenUpdating = True End Sub
[/vba]
Вариант без использования Copy/Past. Этот способ должен быть быстрее на большом количестве данных:
[vba]
Код
Sub Perenos2() Dim LastRow As Long, Rw As Long Application.ScreenUpdating = False LastRow = Cells(Rows.Count, 1).End(xlUp).Row With Sheets("Архив") Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1 For i = 2 To LastRow If Cells(i, 7) = "1" Then .Cells(Rw, 1).Resize(, 6).Value = Range(Cells(i, 1), Cells(i, 6)).Value Rw = Rw + 1 End If Next End With Range("B3:F11").ClearContents Range("B3").Activate MsgBox "Перенос выполнен!", 64, "" Application.ScreenUpdating = True End Sub
[/vba]
Вариант с использованием Copy/Past:
[vba]
Код
Sub Perenos() Dim LastRow As Long, Rw As Long Application.ScreenUpdating = False LastRow = Cells(Rows.Count, 1).End(xlUp).Row With Sheets("Архив") Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1 For i = 2 To LastRow If Cells(i, 7) = "1" Then Range(Cells(i, 1), Cells(i, 6)).Copy .Cells(Rw, 1).PasteSpecial xlPasteValues Rw = Rw + 1 End If Next End With Range("B3:F11").ClearContents Range("B3").Activate MsgBox "Перенос выполнен!", 64, "" Application.ScreenUpdating = True End Sub
[/vba]
Вариант без использования Copy/Past. Этот способ должен быть быстрее на большом количестве данных:
[vba]
Код
Sub Perenos2() Dim LastRow As Long, Rw As Long Application.ScreenUpdating = False LastRow = Cells(Rows.Count, 1).End(xlUp).Row With Sheets("Архив") Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1 For i = 2 To LastRow If Cells(i, 7) = "1" Then .Cells(Rw, 1).Resize(, 6).Value = Range(Cells(i, 1), Cells(i, 6)).Value Rw = Rw + 1 End If Next End With Range("B3:F11").ClearContents Range("B3").Activate MsgBox "Перенос выполнен!", 64, "" Application.ScreenUpdating = True End Sub
Sub Perenos() Dim LastRow As Long, Rw As Long LastRow = Cells(Rows.Count, 1).End(xlUp).Row With Sheets("Архив") Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1 For i = 2 To LastRow If Cells(i, 7) = "1" Then Application.ScreenUpdating = False .Range(.Cells(Rw, 1), .Cells(Rw, 6)).Value = Range(Cells(i, 1), Cells(i, 6)).Value ' заменил эту строчку Rw = Rw + 1 End If Next End With Range("B3:F11").ClearContents Range("B3").Activate MsgBox "Перенос выполнен!", 64, "" Application.ScreenUpdating = True End Sub
[/vba]
попробуйте так: [vba]
Код
Sub Perenos() Dim LastRow As Long, Rw As Long LastRow = Cells(Rows.Count, 1).End(xlUp).Row With Sheets("Архив") Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1 For i = 2 To LastRow If Cells(i, 7) = "1" Then Application.ScreenUpdating = False .Range(.Cells(Rw, 1), .Cells(Rw, 6)).Value = Range(Cells(i, 1), Cells(i, 6)).Value ' заменил эту строчку Rw = Rw + 1 End If Next End With Range("B3:F11").ClearContents Range("B3").Activate MsgBox "Перенос выполнен!", 64, "" Application.ScreenUpdating = True End Sub
Karataev,Michael_S,krosav4ig большое спасибо вам за быстрый ответ. krosav4ig, ваш похож на мой, который я пробовала, но у меня был одной строкой и не работал, а ваш двумя и работает, почему?
Karataev,Michael_S,krosav4ig большое спасибо вам за быстрый ответ. krosav4ig, ваш похож на мой, который я пробовала, но у меня был одной строкой и не работал, а ваш двумя и работает, почему?karmen185
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
