Страницы: 1
RSS
Макрос. Копирование диапазона ячеек на другой лист.
 
Код
Sub ПЕРЕНОС()
'
' ПЕРЕНОС Макрос
'

'
    Range("A2:F3").Select
    Selection.Copy
    Sheets("Маршрутные листы.").Select
    Range("M3").Select
    ActiveSheet.Paste
    Sheets("Заказы.").Select
    Range("A4:F4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Маршрутные листы.").Select
    Range("G3").Select
    ActiveSheet.Paste
    Sheets("Заказы.").Select
    Range("A5:F6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Маршрутные листы.").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    Range("S3").Select
    ActiveSheet.Paste
    Sheets("Заказы.").Select
    Range("A7:F8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Маршрутные листы.").Select
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A3").Select
    ActiveSheet.Paste
End Sub

Как сделать, что бы нужные мне строки перенеслись по кнопке в нужный диапазон? ориентиром для переноса должны служить дата в ячейках "H" и Имя водителя в ячейке "E"
Таблиwа динамичная, нужно что бы заказы по дате отгрузке и водителю отправлялись по своим полочкам, прошу помощи  

Прикладываю файл, как примерный образец.
 
Ну в коде никакого переноса нет, только Copy да Paste. Кстати просьба код оформить как положено на форуме.
Что на самом деле нужно? Копирование или перенос?
 
Копирование, пардон)
Изменено: Oleg Deripassco - 24.07.2020 16:30:39
 
Я пас, с такой организацией данных работать отказываюсь! :)
 
ТС, главная проблема в объединенных ячейках на первом листе (например, там где 2М написано), их обрабатывать макросом и переносить сложнее. Если убрать эти объединенные ячейки, написать в каждой ячейке 2М, то макрос будет легко сделать.

И так же не понятно, что именно с датами. Здесь 5-е число и на второй странице 5-е число. Что именно надо проверять по датам? А если на первом листе будет 5-е число, а на втором 6 число, то не переносить данные?

и как Игорь (Hugo) сказал... Организация данных на листе у вас ужасная немножко...
Изменено: New - 24.07.2020 21:07:31
 
New, меня вот как раз это всё и остановило. 2М ещё как-то сделать можно, например если идти циклом по строкам то проверить этот столбец на объединение и взять все строки (хотя нафига этим заниматься?).
Если это нужно только для печати за один день, и сразу для всех - то может достаточно одной формы, куда или макрос сам в цикле подставит все данные и распечатает после выбора даты, или например оператор меняет дату, затем меняет водителя и данные можно печатать. Всё равно ведь нужно ползать по таблице чтоб всем выставить дату и нажать кнопки...
P.S. А ещё с этими объединениями так - может ведь быть что 2М объединены, а даты разные! :(
Изменено: Hugo - 24.07.2020 21:27:06
 
Hugo, а можно же цикл по столбцам лист2 где отбор и фильтр ставить и копировать...моих знаний не хватает что бы применить фильтр по дате и как урезать диапазон (я вообще не очень дружу с датами).
думал запихнуть дату в фильтр дата=sh2.cells(2,i-1).value , но не фильтрует наверное так как формат разный ...через точку и слэш...
Код
Sub c_p()
Dim i As Long, lr As Long
Dim sh1 As Worksheet, sh2 As Worksheet

Set sh1 = Worksheets("Заказы.")
Set sh2 = Worksheets("Маршрутные листы.")
lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
lcol = sh2.Cells(2, Columns.Count).End(xlToLeft).Column
For i = 2 To lcol Step 6

With sh1
.Range("$A$1:$H$8").AutoFilter Field:=8, Operator:= _
xlFilterValues, Criteria2:=Array(1, "7/7/2020")
.Range("$A$1:$H$8").AutoFilter Field:=5, Criteria1:=sh2.Cells(2, i)
.AutoFilter.Range.Offset(1).Copy
lr2 = sh2.Cells(Rows.Count, i - 1).End(xlUp).Row + 1
sh2.Cells(lr2, i - 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
End With
Next i
End Sub
Изменено: Mershik - 24.07.2020 21:34:42
Не бойтесь совершенства. Вам его не достичь.
 
Я думаю нужно заказчика подождать, пусть скажет зачем это вообще нужно.
Я предполагаю что только для того чтоб распечатать маршрутные листы за какой-то один день.
Т.е. при смене дня сперва нужно поле очистить, убрать все объединения, затем накопировать новые данные.
Что делать если косяк с датами в объединении - вопрос...
Вот например можно так выбрать нужные диапазоны - вместо селекта добавить копирование и готово:

Код
Sub tt()
    Dim c As Range, i&
    With Sheets("Заказы.")
        For Each c In .UsedRange.Columns(5).Cells
            i = i + 1
            If Len(.Cells(i, 5)) Then
            If .Cells(i, 8) = #7/5/2020# Then
                If .Cells(i, 6).MergeCells Then
                    .Cells(i, 6).MergeArea.EntireRow.Columns(1).Resize(, 6).Select
                    i = i + .Cells(i, 6).MergeArea.Rows.Count - 1
                Else
                    .Cells(i, 1).Resize(, 6).Select
                End If
            End If
            End If
        Next
    End With
End Sub

Сюда нужно добавить проверку на водителя. чтоб знать куда копировать. И сверку с датой второго листа.
Ну и если известно что рейс может быть только один (как на первом листе! но не на втором!) то это облегчает задачу :)
Изменено: Hugo - 24.07.2020 22:29:00
 
Вот добил, но с датами там нужно разбираться. Сейчас дата анализируется по первой найденной строке объединения. Да и водитель тоже.
Код
Sub tt()
    Dim c As Range, i&, x&, y&

    With Sheets("Маршрутные листы.").UsedRange.Offset(2)
        .Clear
        .UnMerge
    End With

    With Sheets("Заказы.")
        For Each c In .UsedRange.Columns(5).Cells
            i = i + 1
            If i > 1 Then
                If Len(.Cells(i, 5)) Then

                    Select Case .Cells(i, 5)
                    Case 1: x = 13
                    Case 2: x = 1
                    Case 3: x = 19
                    Case 4: x = 7
                    End Select

                    If .Cells(i, 8) = Sheets("Маршрутные листы.").Cells(2, x) Then
                        y = Sheets("Маршрутные листы.").Cells(.Rows.Count, x).End(xlUp).Row

                        If .Cells(i, 6).MergeCells Then
                            .Cells(i, 6).MergeArea.EntireRow.Columns(1).Resize(, 6).Copy Sheets("Маршрутные листы.").Cells(y + 1, x)
                            i = i + .Cells(i, 6).MergeArea.Rows.Count - 1
                        Else
                            .Cells(i, 1).Resize(, 6).Copy Sheets("Маршрутные листы.").Cells(y + 1, x)
                        End If
                        
                    End If
                End If
            End If
        Next
    End With
End Sub
Изменено: Hugo - 24.07.2020 23:28:44
 
Hugo,  всё верно, нужен маршрутный лист за конкретный период, в моем случае - 1 день. проблему с объединенными ячейками понял, да, можно и без них.

И вот вопрос, как прикрепить всё это существо по нужной дате.. в маршрутном листе с лева сверху стоит дата ("=Сегодня()") можно ли связать дату отгрузки на листе "Заказы" и дату "Сегодня" на маршрутном листе?

UPD: В образце стоит число, но я думаю лучше будет "=Сегодня()" .. ?
Страницы: 1
Наверх