Страницы: 1
RSS
Макрос копирование данных в динамический диапазон
 
Есть записанный макрос, который копирует ячейки в выбранный диапазон, дело в том что строки могут добавляться и тогда все плывет, как сделать чтобы диапазон был динамический?
Код
Range("E45:E48,E53:E54,E59:E62").Select
    Range("E59").Activate
    Selection.Copy
    ActiveWindow.SmallScroll Down:=6
    Range("B68:B77").Select 
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("F45:F48,F53:F54").Select
    Range("F53").Activate
    Selection.Copy
    Range("C68:C73").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("G59:G62").Select
    Selection.Copy
    Range("C74:C77").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("E64").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    Range("B67:C77").Select
    ActiveWorkbook.Worksheets("Detailed").sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Detailed").sort.SortFields.Add Key:=Range( _
        "B68:B77"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Detailed").sort
        .SetRange Range("B67:C77")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("D64").Select
End Sub

 
kosyak777,у вашем макросе очень много лишних действий
какой именно диапазон должен быть изменняем?

Как вариант используйте именованный диапазон.
и замените в макросе дипазоны на свои именованные диапазоны
 
Цитата
ivanok_v2 написал: используйте именованный диапазон.и замените в макросе дипазоны на свои именованные диапазоны
как это написать?
 
kosyak777,
как создать именованный диапазон

диапазон "B68:B77" назвать РОГА
Цитата
kosyak777 написал:
как это написать?
потом в макросе
Код
Range("РОГА").Select
 
ivanok_v2,а не подскажете еще, в этом коде есть сортировка, но так как после добавления строк будет таблица съезжать то и сортировка нужна тоже в именно диапазоне, а если делать так как вы сказали то он начинает ругаться и выдает ошибку "Недопустимая ссылка для сортировки. Убедитесь, что она указывает на данные, которые требуется отсортировать"
Код
 Range("B67:C77").Select
 ActiveWorkbook.Worksheets("Detailed").sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Detailed").sort.SortFields.Add Key:=Range( _
        "B68:B77"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Detailed").sort
        .SetRange Range("B67:C77")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Изменено: kosyak777 - 09.11.2018 11:52:02
 
kosyak777, вам нужно диапазон сортировки тоже назвать
 
ivanok_v2,я назвал и в коде поменял. выдает ошибку:
Цитата
kosyak777 написал:
"Недопустимая ссылка для сортировки. Убедитесь, что она указывает на данные, которые требуется отсортировать"
 
Цитата
kosyak777 написал:
выдает ошибку
пример в студию
 
ivanok_v2,есть три таблицы откуда берем данные, копируем в другую таблицу и сортируем.
 
Цитата
kosyak777 написал:
три таблицы откуда берем данные
у вашем примере етого не увидел
Цитата
kosyak777 написал:
копируем в другую таблицу и сортируем
етого тоже не увидел.
Можете выложить часть примера с макросом.
что есть и что нужно
 
ivanok_v2,извиняюсь, не тот файл выложил, макрос в модуле листа.
 
Код
Public Sub copy_paste()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim tmp1&, tmp2&, tmp3&
    
    With ActiveWorkbook.ActiveSheet
        tmp1& = lastRow(4, 1) - 1: Set rng1 = .Range("A4:B" & tmp1&)
        
        tmp2& = lastRow(tmp1& + 3, 1) - 1: Set rng2 = .Range("A" & tmp1& + 3 & ":B" & tmp2&)
        
        tmp3& = lastRow(tmp2& + 3, 1) - 1: Set rng3 = .Range("A" & tmp2& + 3 & ":B" & tmp3&)
        
        .Range(rng1.Address & "," & rng2.Address & "," & rng3.Address).Copy
        Range("A" & tmp3& + 5).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        With .Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("A" & tmp3& + 5 & ":B" & lastRow(tmp3& + 5, 1) - 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Application.CutCopyMode = False
    End With
End Sub
Private Function lastRow(ByVal startRow&, findColumn&) As Long
    For lastRow = startRow& To 1000000
        If ActiveWorkbook.ActiveSheet.Cells(lastRow&, findColumn&) = "" Then Exit For
    Next
End Function
 
ivanok_v2,Извиняюсь, что так поздно отвечаю и спасибо, но я вставил макрос в модуль, он работает, но при добавление новой строки все съезжает и появляется новая строка, в общем не знаю как объяснить, но попробуйте добавить где-нибудь новую строку до 22 строки и запустить макрос.
Изменено: kosyak777 - 12.11.2018 09:54:44
Страницы: 1
Наверх