Страницы: 1
RSS
Перенос значений на другой лист
 
Доброго времени суток, дорогие форумчане!

Есть такая задача:
Необходимо с одного листа на другой внутри одной книги произвести копирование строк по определенным параметрам.
Данную функцию, благодаря этому форуму уже реализовал, но!

Необходимо не просто копировать, а ещё и вставлять данные немного не в том порядке, в котором они расположены на исходном листе.
Допустим:
На исходном листе порядок ячеек такой: 1, 2, 3, 4, 5, 6, 7
На итоговом листе должны быть в таком порядке: 1, 2, 3, 7, 5, 4, 6

Таблицы заданы руководящими документами и менять расположение ячеек нельзя. В файле, на итоговом листе, указаны номера ячеек исходного листа в тех столбцах, куда надо их вставлять.

Помогите, пожалуйста.
 
Готово! Новая кнопка на первом листе.
 
Можно без циклов. Проще и быстрее.
Код
Sub Macro1()
    With Sheets("Заявка на поверку")
        .Rows("12:" & Rows.Count).Clear
        Range("A4:R" & Cells(Rows.Count, 1).End(xlUp).Row).AdvancedFilter xlFilterCopy, , .Range("A11:I11")
        Intersect(.Columns("I"), .Rows("12:" & Rows.Count)).NumberFormat = "mmmm"
    End With
End Sub
Пример во вложении.
Чем шире угол зрения, тем он тупее.
 
Спасибо большое!

Но куда-то исчезла фильтрация по критерию планируемой даты поверки.
Прошу прощения, не указал в первом сообщении, что фильтр по диапазону дат необходим обязательно.
Изменено: Korvin192 - 18.02.2019 17:31:00
 
Пытаюсь сам скрестить созданные макросы с отбором по критерию, но ничего не выходит...
 
Цитата
Korvin192 написал:
фильтр по диапазону дат необходим обязательно
На каком листе, в каком столбце стоит фильтр? Или что из себя представляет фильтр? Как его увидеть, понять?
 
Фильтр стоит в макросе www().
Производится фильтрация по 13-му столбцу.
Отбираются те записи, у которых срок поверки в следующем году, относительно текущего года.

В итоге необходимо:
1. Отфильтровать записи по критерию
2. Перенести их на другой лист и распределить там в правильных столбцах.
3. Нумерация в таблице на новом листе должна начинаться с 1.
4. В документе может быть несколько листов с данными, которые надо переносить. Поэтому и реализован цикл по листам.  
 
Решение было найдено. Можно закрывать тему
 
Нашли - так поделитесь. Не Вы один на форуме, решение может помочь еще кому-то.
 
Решение было найдено. Можно закрывать тему
Я просто подогнал решение, предложенное Юрием к своему условию:
Код
    Dim pl1
    Dim pl2
    Dim z As Long, sh As Worksheet, sh1 As Worksheet
    Dim LastRow As Long, i As Long, FreeRow As Long
    Dim plat
    
    pl1 = Format(CDate("01.01.2020"), "#")
    pl2 = Format(CDate("31.12.2020"), "#")
    Set sh = ActiveWorkbook.Worksheets("Заявка на поверку")
    Set sh1 = ActiveWorkbook.Worksheets("ФОРМА 16")
    LastRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
    
    sh.Range(sh.Cells(12, 1), sh.Cells(LastRow + 10, 9)).Clear ' Очищаем поле Заявки
    FreeRow = 12
    z = 1
    LastRow = sh1.Cells(Rows.Count, 1).End(xlUp).Row ' Вычисляем последнюю строку на Форме 16
    
    For i = 5 To LastRow
        plat = Format(sh1.Cells(i, 13), "#")
        If plat >= pl1 And plat <= pl2 Then
            sh.Cells(FreeRow, 1).Value = z
            sh.Range(sh.Cells(FreeRow, 2), sh.Cells(FreeRow, 4)).Value = sh1.Range(sh1.Cells(i, 2), sh1.Cells(i, 4)).Value
            sh.Cells(FreeRow, 5) = sh1.Cells(i, 18)
            sh.Cells(FreeRow, 6) = sh1.Cells(i, 10)
            sh.Cells(FreeRow, 7) = sh1.Cells(i, 5)
            sh.Cells(FreeRow, 8 = sh1.Cells(i, 17)
            sh.Cells(FreeRow, 9) = Format(sh1.Cells(i, 13), "mmmm")
            FreeRow = FreeRow + 1
            z = z + 1
        End If
    Next
    sh.Range(sh.Cells(12, 1), sh.Cells(FreeRow - 1, 9)).Borders.LineStyle = True
    LastRow = sh.Cells(Rows.Count, 1).End(xlUp).Row

Изменено: Korvin192 - 04.03.2019 10:44:15
Страницы: 1
Наверх