Макрос для копирования строки и вставки в нижестоящую ячейку

Макрос для копирования строки и вставки в нижестоящую ячейку, вставка строки в книгу с определенно-заданными условиями

Пользователь

Сообщений: 20 Регистрация: 26.06.2018

08.11.2018 09:42:55

Всем привет! Написал макрос макрорекодером на копирование строки, но вот что-то не получилось сделать так, чтобы таблица сохраняла исходное форматирование и при этом должен вставляться порядковый номер в столбец А и дата ввода информации в столбец G.

Код

Sub Макрос2()
    ActiveCell.Offset(3, 0).Range("A1:A3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.Offset(0, 1).Range("A1:A3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.Offset(0, 2).Range("A1:A3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.Offset(0, 1).Range("A1:A3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.Offset(0, 1).Range("A1:A3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.Offset(0, 1).Range("A1:A3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.Offset(-3, -6).Range("A1:A3").Select
    ActiveCell.FormulaR1C1 = "1"
    ActiveCell.Range("A1:G3").Select
    Selection.Copy
    ActiveCell.Offset(3, 0).Range("A1:A3").Select
    ActiveSheet.Paste
    ActiveCell.Offset(4, 0).Range("A1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    ActiveCell.Offset(-4, 0).Range("A1:A3").Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Range("A1:A3").Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.ClearContents
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.ClearContents
    ActiveCell.Offset(-1, 1).Range("A1:A3").Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Range("A1:A3").Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Range("A1:A3").Select
    Selection.ClearContents
    ActiveCell.Offset(0, 1).Range("A1:A3").Select
    Selection.ClearContents
    ActiveCell.FormulaR1C1 = "=DATE(2018,11,9)"
    ActiveCell.Offset(3, -6).Range("A1").Select
End Sub

Спасибо.

Прикрепленные файлы

Макрос для вставки строки.xls (40.5 КБ)

Изменено: YOrek - 08.11.2018 10:43:55

V Пользователь Сообщений: 5205 Регистрация: 22.12.2012	#2 08.11.2018 09:56:02 словами опишите что куда нужно копировать.

Пользователь

Сообщений: 5205 Регистрация: 22.12.2012

08.11.2018 10:10:14

проверяйте, если правильно понял.

Код

Sub vvv()
Range("A4:G6").Copy
With Range("A" & ActiveCell.Row)
  .PasteSpecial
  .Value = Range("A" & ActiveCell.Row - 3) + 1
  .Offset(0, 1).Resize(3).ClearContents
  .Offset(0, 3).Resize(3,2).ClearContents
  .Offset(0, 2).Resize(2).ClearContents
  .Offset(0, 6).Value = Date
End With
End Sub

Изменено: V - 08.11.2018 10:12:42

YOrek Пользователь Сообщений: 20 Регистрация: 26.06.2018	#4 08.11.2018 19:14:08 Спасибо, помогло