Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Копирование и вставка, как значение - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование и вставка, как значение (Макросы/Sub)
Копирование и вставка, как значение
karmen185 Дата: Пятница, 16.11.2018, 21:08 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Здравствуйте уважаемые форумчане. Суть проблемы в следующем: есть макрос, который копирует данные на другой лист со всеми формулами, а надо, как значение. Пробовала внедрить в него 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
[/vba]

Автор - karmen185
Дата добавления - 16.11.2018 в 21:08
Karataev Дата: Пятница, 16.11.2018, 21:15 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 1268
Репутация: 489 ±
Замечаний: 0% ±

Excel
Вариант с использованием Copy/Past:

Вариант без использования Copy/Past. Этот способ должен быть быстрее на большом количестве данных:


Киви-кошелек: 9166309108
Яндекс-деньги: 410014131888288
 
Ответить
СообщениеВариант с использованием Copy/Past:

Вариант без использования Copy/Past. Этот способ должен быть быстрее на большом количестве данных:

Автор - Karataev
Дата добавления - 16.11.2018 в 21:15
Michael_S Дата: Пятница, 16.11.2018, 21:19 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 1884
Репутация: 352 ±
Замечаний: 0% ±

Excel2016
попробуйте так:
[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
[/vba]


ЯД: 41001136675053
WM: R389613894253
 
Ответить
Сообщениепопробуйте так:
[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
[/vba]

Автор - Michael_S
Дата добавления - 16.11.2018 в 21:19
krosav4ig Дата: Пятница, 16.11.2018, 21:28 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 1735
Репутация: 728 ±
Замечаний: 0% ±

Excel 2007,2010,2013


(_)Õvõ(_)

Сообщение отредактировал krosav4ig - Пятница, 16.11.2018, 21:31
 
Ответить
Сообщение

Автор - krosav4ig
Дата добавления - 16.11.2018 в 21:28
karmen185 Дата: Пятница, 16.11.2018, 21:41 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Karataev,Michael_S,krosav4ig большое спасибо вам за быстрый ответ. krosav4ig, ваш похож на мой, который я пробовала, но у меня был одной строкой и не работал, а ваш двумя и работает, почему?
 
Ответить
СообщениеKarataev,Michael_S,krosav4ig большое спасибо вам за быстрый ответ. krosav4ig, ваш похож на мой, который я пробовала, но у меня был одной строкой и не работал, а ваш двумя и работает, почему?

Автор - karmen185
Дата добавления - 16.11.2018 в 21:41
karmen185 Дата: Пятница, 16.11.2018, 21:50 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Ой, а можно ещё один вопрос по этому макросу, как указать постоянный адрес для копирования Range("B3:F11")?
 
Ответить
СообщениеОй, а можно ещё один вопрос по этому макросу, как указать постоянный адрес для копирования Range("B3:F11")?

Автор - karmen185
Дата добавления - 16.11.2018 в 21:50
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование и вставка, как значение (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!