Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Вставка строки с копированием данных
 
Не могу разобраться, выручайте.
Код
Sub Статья()

SName = InputBox("Укажите имя статьи", "Имя столбца", "")
If ActiveCell.Row < 9 Then
        MsgBox "Укажите крайнюю статью необходимого подраздела"
    Else
    With ActiveCell.EntireRow
            .Insert
            .Copy .Rows(0)
            .ClearContents
            .FormulaR1C1 = SName
        End With
    End If
End Sub

Как доработать скрипт так, что бы имя присваивалось только ячейке "А".
Можно ли сделать чтобы после очистки из активной строки копировались ячейки "В" и "С"?

Буду очень признателен!
Изменено: simbiot - 3 Мар 2017 17:11:39
 
simbiot, код следует оформлять соответствующим тегом. Ищите такую кнопку и исправьте своё сообщение.
Спасибо!
Тег VBA.jpg (19.2 КБ)
 
Сделал! И еще добавил образец.
 
Вот так?
Код
Sub Статья()
 
SName = InputBox("Укажите имя статьи", "Имя столбца", "")
If ActiveCell.Row < 9 Then
        MsgBox "Укажите крайнюю статью необходимого подраздела"
    Else
    With ActiveCell.EntireRow
            .Insert
            .Copy .Rows(0)
            .ClearContents
        End With
    Cells(ActiveCell.Row + 1, 1).Value = sname
    Cells(ActiveCell.Row + 1, 2).Value = Cells(ActiveCell.Row, 2)
    Cells(ActiveCell.Row + 1, 3).Value = Cells(ActiveCell.Row, 3)
    End If
End Sub
 
Что-то не работает. Можно на примере?
 
Ловите
 
Да, отлично, спасибо!!!
 
А есть вариант раздел добавить?
А еще было бы круто все ячейки после 3й одного цвета, так как копируется цвет исполненного платежа. В головном файле(не образце), суммы факта и плана складываются по критерию цвета ячейки. Новая статья расхода копирует цвет предыдущей статьи как пустые так и исполненные ячейки.

Головной файл тяжелый, сюда не лезет.
Изменено: simbiot - 1 Мар 2017 14:23:01
 
Аппетит приходит во время еды. Не обязательно весь, можно несколько строк, чтобы понятнее было
 
Хух, урезал в лимит.
Убрал наличные деньги.
Не могу сократить график до одного года :(
 
Вы не могли бы показать вариант до добавления и после добавления, а то мне сложно понять что именно требуется. А есть вариант раздел добавить?  - куда его добавить? все ячейки после 3й одного цвета - какого именно?
 
Вот выделил раздел. Вставляется он между сдвоенными(черными) разделительными строками.
Мол выбираем разделительную строку(черную 3 пикс.) делая ее активной, и под нее скрипт выливает раздел.
Раздел состоит из заголовка, трех статей расхода и одной разделительной строки
 
А как узнать какие цвета, название заголовка и статей?
 
Всего два вида раздела: приход(зеленый) и расход(оранжевый). Ну а название ввести как sname. Статьи просто обозвать "Новая статья"
 
Так нужно?
 
Идею понял, оч круто! Но что-то скрипт не работает, что-то со ссылками. Разбираюсь...
Заработало! Все супер! Спасибо огромное. Сейчас попробую добавить копирование В и С столбов.

Спасибо!
Изменено: simbiot - 3 Мар 2017 17:12:02
 
Вот что вышло, работает на ура:
Код
Sub Раздел()
   
Set y = Cells.Find(What:="Расход счет", LookIn:=xlValues, LookAt:=xlWhole)
Set x = Application.InputBox("Укажите ячейку, под которой добавить раздел", "Запрос для раздела", "", Type:=8)
Set Z = Cells.Find(What:="Приход счет", LookIn:=xlValues, LookAt:=xlWhole)
sname = InputBox("Укажите имя раздела", "")
Range(Cells(x.Row + 1, 1), Cells(x.Row + 5, 1)).EntireRow.Select
Selection.Insert Shift:=xlDown
Range(Cells(x.Row + 1, 1), Cells(x.Row + 4, 1)).EntireRow.RowHeight = 18
Range(Cells(x.Row + 1, 1), Cells(x.Row + 4, 1)).EntireRow.Interior.Color = 16777215
Cells(x.Row + 1, 1).Value = sname
Range(Cells(x.Row + 2, 1), Cells(x.Row + 4, 1)).HorizontalAlignment = xlLeft
Range(Cells(x.Row + 2, 1), Cells(x.Row + 4, 1)).Value = "Новая статья"
    If y.Row > x.Row Then
    
    Rows(Z.Row + 2).Select
    Selection.Copy
    Rows(x.Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    Rows(Z.Row + 3).Select
    Selection.Copy
    Range(Rows(x.Row + 2), Rows(x.Row + 4)).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    
    Range(Cells(Z.Row + 2, 2), Cells(Z.Row + 6, 3)).Select
    Selection.Copy
    Range(Cells(x.Row + 1, 2), Cells(x.Row + 5, 3)).Select
    ActiveSheet.Paste
        
    Else
         Rows(y.Row + 2).Select
    Selection.Copy
    Rows(x.Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    Rows(y.Row + 3).Select
    Selection.Copy
    Range(Rows(x.Row + 2), Rows(x.Row + 4)).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    
   Range(Cells(y.Row + 2, 2), Cells(y.Row + 6, 3)).Select
    Selection.Copy
    Range(Cells(x.Row + 1, 2), Cells(x.Row + 5, 3)).Select
    ActiveSheet.Paste
    End If
Range(Cells(x.Row + 2, 1), Cells(x.Row + 5, 1)).EntireRow.Select
Selection.Group
  
    
End Sub
Страницы: 1
Читают тему (гостей: 1)