Страницы: 1
RSS
VBA копирование со сдвигом
 
Добрый день.
Помогите, пожалуйста.
Есть макрос, который копирует данные и вставляет их как значение на лист сводная. При текущем макросе, каждый раз при выполнении данные записываются поверх старых, а нужно, чтобы вставка производилась каждый раз в строку ниже...
VBA совсем не знаю, попыталась сама, но не получилось(
Если кто сможет помочь, буду крайне признательна.

Код
Sub Макрос8()
'
' Макрос8 Макрос
'

'
    Range("A4").Select
    Selection.Copy
    Sheets("Сводная").Select
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Лист1").Select
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Сводная").Select
    Range("C4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Лист1").Select
    Range("B6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A41:A42").Select
    Sheets("Сводная").Select
    Range("D4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Лист1").Select
    Range("B7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Сводная").Select
    Range("E4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Лист1").Select
    Range("B8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Сводная").Select
    Range("F4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub
Изменено: oncila - 04.08.2020 13:02:03
 
Ирина Пятакова, добрый день.
Вы бы оформили свое сообщение в соответствии с правилами форума, приложили файл с примером, а то придут модераторы и ругаться будут
 
Ирина Пятакова, отредактируйте код в первом сообщении
Код
Sub Макрос7()
'
Dim i As Long
i = ThisWorkbook.Sheets("Сводная").Cells(Rows.Count, 2).End(xlUp).Row + 1
    With ThisWorkbook.Sheets("Сводная")
        .Range("B" & i) = Sheets("Лист1").Range("A4")
        .Range("C" & i) = Sheets("Лист1").Range("B5")
        .Range("D" & i) = Sheets("Лист1").Range("B6")
        .Range("E" & i) = Sheets("Лист1").Range("B8")
        .Range("F" & i) = Sheets("Лист1").Range("B7")
    End With
End Sub
Страницы: 1
Наверх