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

Вход

Регистрация

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

 

= Мир MS Excel/Перенос данных на другой лист по условию - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос данных на другой лист по условию (Макросы/Sub)
Перенос данных на другой лист по условию
Pendalfik Дата: Вторник, 07.04.2020, 13:59 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Доброго времени суток.
Посоветуйте, как исправить макрос, прописанный в первом листе. При внесении записей на данный лист, макрос в третьей колонке ставит текущую дату и, при записи в 11 столбце ИП или КЕК, переносит запись на соответствующий лист. Всё работает, но возникла необходимость менять номера (первый столбец) на данном листе. При изменении или дозаписи номера записи на листах ИП и КЕК начинают дублироваться. Возможно ли избежать дублирования? Код и образец книги прилагаю.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B2:B19999")) Is Nothing Then
With Target(1, 3)
.Value = Date
.EntireColumn.AutoFit
End With
End If
    Dim R&, RSheet&, ShName$
    Dim Rn As Range
    R = Target.Row
    Set Rn = Range(Cells(R, 2), Cells(R, 7))
    If WorksheetFunction.CountA(Rn) = 6 Then
        ShName = Cells(R, 11)
        On Error Resume Next
        With Sheets(ShName)
            If Err Then Exit Sub
            RSheet = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Cells(RSheet, 1) = Val(.Cells(RSheet - 1, 1)) + 1
            Rn.Copy .Cells(RSheet, 2)
        End With
    End If
    Target.Activate
End Sub
[/vba]
К сообщению приложен файл: 9232052.xlsm(37.2 Kb)
 
Ответить
СообщениеДоброго времени суток.
Посоветуйте, как исправить макрос, прописанный в первом листе. При внесении записей на данный лист, макрос в третьей колонке ставит текущую дату и, при записи в 11 столбце ИП или КЕК, переносит запись на соответствующий лист. Всё работает, но возникла необходимость менять номера (первый столбец) на данном листе. При изменении или дозаписи номера записи на листах ИП и КЕК начинают дублироваться. Возможно ли избежать дублирования? Код и образец книги прилагаю.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B2:B19999")) Is Nothing Then
With Target(1, 3)
.Value = Date
.EntireColumn.AutoFit
End With
End If
    Dim R&, RSheet&, ShName$
    Dim Rn As Range
    R = Target.Row
    Set Rn = Range(Cells(R, 2), Cells(R, 7))
    If WorksheetFunction.CountA(Rn) = 6 Then
        ShName = Cells(R, 11)
        On Error Resume Next
        With Sheets(ShName)
            If Err Then Exit Sub
            RSheet = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Cells(RSheet, 1) = Val(.Cells(RSheet - 1, 1)) + 1
            Rn.Copy .Cells(RSheet, 2)
        End With
    End If
    Target.Activate
End Sub
[/vba]

Автор - Pendalfik
Дата добавления - 07.04.2020 в 13:59
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос данных на другой лист по условию (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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