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

Вход

Регистрация

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

 

= Мир MS Excel/Поиск и перенос по сов. данных разного формата на новый лист - Мир MS Excel

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

Уважаемые форумчане, здравствуйте.
Очень нужна ваша помощь, пожалуйста откликнитесь.
Есть сводная таблица с датами, текстом, значениями (приложу к сообщению), в которой нужно по данным из столбца (например AG, "требуется") при совпадении, на новый лист перенести найденные строки. Вот только строка нужна на новом листе не вся, а например первые 4 ячейки, 5тую, и с 29той по 32ю. И если возможно, на новом листе формировать таблицу уже с заголовками перенесённых столбцов.
Буду очень благодарен.
К сообщению приложен файл: _____.xlsx(46.6 Kb)
 
Ответить
СообщениеУважаемые форумчане, здравствуйте.
Очень нужна ваша помощь, пожалуйста откликнитесь.
Есть сводная таблица с датами, текстом, значениями (приложу к сообщению), в которой нужно по данным из столбца (например AG, "требуется") при совпадении, на новый лист перенести найденные строки. Вот только строка нужна на новом листе не вся, а например первые 4 ячейки, 5тую, и с 29той по 32ю. И если возможно, на новом листе формировать таблицу уже с заголовками перенесённых столбцов.
Буду очень благодарен.

Автор - Velor31
Дата добавления - 27.09.2021 в 15:26
Kuzmich Дата: Понедельник, 27.09.2021, 18:05 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 621
Репутация: 135 ±
Замечаний: 0% ±

Excel 2003
Цитата
на новый лист перенести найденные строки

[vba]
Код
Sub PoiskPerenos()
Dim iLR As Long
Dim FoundCell As Range
Dim FAdr As String
    With Worksheets("Лист1")
      .Cells.Clear
        Set FoundCell = Columns("AG").Find("требуется", , xlValues, xlWhole)
       If Not FoundCell Is Nothing Then
        FAdr = FoundCell.Address
           Range("A2:E2").Copy .Range("A1")     'копируем заголовки
           Range("AC2:AE2").Copy .Range("F1")
         Do
           iLR = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
           Range("A" & FoundCell.Row & ":E" & FoundCell.Row).Copy .Cells(iLR, "A")
           Range("AC" & FoundCell.Row & ":AE" & FoundCell.Row).Copy .Cells(iLR, "F")
          Set FoundCell = Columns("AG").FindNext(FoundCell)
         Loop While FoundCell.Address <> FAdr
       End If
    End With
End Sub
[/vba]
Запускать при активном листе ШР
 
Ответить
Сообщение
Цитата
на новый лист перенести найденные строки

[vba]
Код
Sub PoiskPerenos()
Dim iLR As Long
Dim FoundCell As Range
Dim FAdr As String
    With Worksheets("Лист1")
      .Cells.Clear
        Set FoundCell = Columns("AG").Find("требуется", , xlValues, xlWhole)
       If Not FoundCell Is Nothing Then
        FAdr = FoundCell.Address
           Range("A2:E2").Copy .Range("A1")     'копируем заголовки
           Range("AC2:AE2").Copy .Range("F1")
         Do
           iLR = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
           Range("A" & FoundCell.Row & ":E" & FoundCell.Row).Copy .Cells(iLR, "A")
           Range("AC" & FoundCell.Row & ":AE" & FoundCell.Row).Copy .Cells(iLR, "F")
          Set FoundCell = Columns("AG").FindNext(FoundCell)
         Loop While FoundCell.Address <> FAdr
       End If
    End With
End Sub
[/vba]
Запускать при активном листе ШР

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

Kuzmich,
Спасибо Вам большое.
Работает.
 
Ответить
СообщениеKuzmich,
Спасибо Вам большое.
Работает.

Автор - Velor31
Дата добавления - 28.09.2021 в 10:02
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск и перенос по сов. данных разного формата на новый лист (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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