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

Вход

Регистрация

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

 

= Мир MS Excel/Макрос - Перенос строк в таблицу на другой лист - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос - Перенос строк в таблицу на другой лист (Макросы/Sub)
Макрос - Перенос строк в таблицу на другой лист
ZaNuda Дата: Вторник, 05.04.2022, 17:00 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Уважаемые форумчане. Заранее прошу прощения за беспокойство.
Не могли бы Вы помочь с одним макросом. Голова уже пухнет от информации.
Нужно сделать так, чтобы при нажатии на кнопку, определенные условием строки таблицы переносились в таблицу на другом листе. Условие - заполненная ячейка в этой строке, которую надо перенести. Ну и соответственно строка должна быть удалена в исходной таблице

Файлик приложил.

Большое спасибо, если вдруг кто-то решит помочь.
Внутри одного листа перенос я освоил кое-как, а вот с другим листом не получается.


Сообщение отредактировал ZaNuda - Вторник, 05.04.2022, 17:20
 
Ответить
СообщениеУважаемые форумчане. Заранее прошу прощения за беспокойство.
Не могли бы Вы помочь с одним макросом. Голова уже пухнет от информации.
Нужно сделать так, чтобы при нажатии на кнопку, определенные условием строки таблицы переносились в таблицу на другом листе. Условие - заполненная ячейка в этой строке, которую надо перенести. Ну и соответственно строка должна быть удалена в исходной таблице

Файлик приложил.

Большое спасибо, если вдруг кто-то решит помочь.
Внутри одного листа перенос я освоил кое-как, а вот с другим листом не получается.

Автор - ZaNuda
Дата добавления - 05.04.2022 в 17:00
ZaNuda Дата: Вторник, 05.04.2022, 17:02 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Файл
К сообщению приложен файл: ______.xlsm(19.6 Kb)
 
Ответить
СообщениеФайл

Автор - ZaNuda
Дата добавления - 05.04.2022 в 17:02
jun Дата: Среда, 06.04.2022, 12:10 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 54
Репутация: 9 ±
Замечаний: 0% ±

код:
[vba]
Код
Sub Перенос()
Dim item As Range, LastRow As Long, LastRowRNG As Long, j As Long
Dim rng As Range
LastRow = Sheets("АРХИВ").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("ПРОДАЖИ")
    LastRowRNG = .Cells(.Rows.Count, 1).End(xlUp).Row
    For j = 5 To LastRowRNG
        If .Cells(j, 10).Value <> "" Then
            If rng Is Nothing Then
                Set rng = Rows(.Cells(j, 10).Row)
            Else
                Set rng = Union(rng, Rows(.Cells(j, 10).Row))
            End If
        End If
    Next j
    If Not rng Is Nothing Then
        rng.Copy Sheets("АРХИВ").Cells(LastRow + 1, 1)
        For Each item In rng.Areas
            item.EntireRow.Delete
        Next item
    rng = Nothing
    End If
End With
End Sub

[/vba]
К сообщению приложен файл: 6145494.xlsm(25.7 Kb)


Сообщение отредактировал jun - Четверг, 07.04.2022, 09:39
 
Ответить
Сообщениекод:
[vba]
Код
Sub Перенос()
Dim item As Range, LastRow As Long, LastRowRNG As Long, j As Long
Dim rng As Range
LastRow = Sheets("АРХИВ").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("ПРОДАЖИ")
    LastRowRNG = .Cells(.Rows.Count, 1).End(xlUp).Row
    For j = 5 To LastRowRNG
        If .Cells(j, 10).Value <> "" Then
            If rng Is Nothing Then
                Set rng = Rows(.Cells(j, 10).Row)
            Else
                Set rng = Union(rng, Rows(.Cells(j, 10).Row))
            End If
        End If
    Next j
    If Not rng Is Nothing Then
        rng.Copy Sheets("АРХИВ").Cells(LastRow + 1, 1)
        For Each item In rng.Areas
            item.EntireRow.Delete
        Next item
    rng = Nothing
    End If
End With
End Sub

[/vba]

Автор - jun
Дата добавления - 06.04.2022 в 12:10
ZaNuda Дата: Среда, 06.04.2022, 16:56 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

jun, jun, Большущее спасибо, добрый человек!!
Все работает, но есть замечание.

Когда переносишь данные в первый раз, все работает правильно.
Но если переносить их повторно, то переписывается только последняя строка в таблице ,а не создается новая.
Возможно это исправить?


Сообщение отредактировал ZaNuda - Четверг, 07.04.2022, 06:20
 
Ответить
Сообщениеjun, jun, Большущее спасибо, добрый человек!!
Все работает, но есть замечание.

Когда переносишь данные в первый раз, все работает правильно.
Но если переносить их повторно, то переписывается только последняя строка в таблице ,а не создается новая.
Возможно это исправить?

Автор - ZaNuda
Дата добавления - 06.04.2022 в 16:56
jun Дата: Четверг, 07.04.2022, 08:16 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 54
Репутация: 9 ±
Замечаний: 0% ±

то переписывается только последняя строка в таблице ,а не создается новая.

ZaNuda, прошу прощения, ошибся.

Исправил код в третьем сообщении, проверьте.
Теперь учитывает порядок следования строк.

Спасибо!


Сообщение отредактировал jun - Четверг, 07.04.2022, 09:35
 
Ответить
Сообщение
то переписывается только последняя строка в таблице ,а не создается новая.

ZaNuda, прошу прощения, ошибся.

Исправил код в третьем сообщении, проверьте.
Теперь учитывает порядок следования строк.

Спасибо!

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

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