Макрос выделения неопределнной области

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Макрос выделения неопределнной области (Макросы/Sub)

wemaxie

Дата: Четверг, 06.04.2017, 11:16 | Сообщение № 1

Группа: Заблокированные

Ранг: Прохожий

Сообщений: 8

Репутация: 1 ±

Замечаний: 20% ±

Excel 2010

Нужен макрос который бы
1) удалял 10 строк
2) выделял следующие 35 строк и копировал на новый лист
3) начинал с п.1 и так далее пока не кончатся таблицы
Проблема в том что не получается передать переменные с координатами в Range.
Вот код:
[vba]

Код

Sub Разбивка_таблицы()
p1 = "A1" '1 точка (Левый Верхний угол)
p2 = "S9" '2ая точка (Правый нижний угол)
p3 = p1 'неважно
sourcews = ActiveSheet.Name 'Исходный лист
Range("A:S").Find("Итого по абоненту").Select 'Нахождение ячейки
ActiveCell.Offset(0, 1).Select 'Сдвиг выделения на две ячейки вправо
ActiveCell.Offset(0, 1).Select
Set Zapisi = Range(ActiveCell.Address) 'Считывание количества записей в таблице
'-----------------------
Do While Zapisi = 0
Range(p1).Select
ActiveCell.Offset(9, 0).Select 'Сдвиг ВП вниз на 9 ячеек
Set p1 = Range(ActiveCell.Address) 'Запоминаниие нового адреса
'-----
Range(p2).Select
ActiveCell.Offset(34, 0).Select 'Сдвиг ПН вниз на 34 ячейки
Set p2 = Range(ActiveCell.Address) 'Запись нового адреса
'-----
Range(p1, p2).Select 'Выделение нужной области
Selection.Copy 'Копирование
'-----
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste 'Создание нового листа и копирования на него
ActiveSheet.Previous.Select
Zapisi = Zapisi - 34
Loop
End Sub

[/vba]

kaef.

Ответить

nilem

Дата: Четверг, 06.04.2017, 11:45 | Сообщение № 2

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

Репутация: 563 ±

Замечаний: 0% ±

Excel 2013, 2016

попробуйте так:
[vba]

Код

Sub ttt()
Dim i&
i = 11
With Sheets("Лист3")
    Do While Cells(i, 1) <> ""
        Cells(i, 1).Resize(35, 19).Copy
        .Cells(Rows.Count, 1).End(xlUp)(2, 1).PasteSpecial Paste:=xlPasteValues
        i = i + 45
    Loop
End With
Application.CutCopyMode = False
End Sub

[/vba]

Яндекс.Деньги 4100159601573

Ответить

wemaxie

Дата: Четверг, 06.04.2017, 11:54 | Сообщение № 3

Группа: Заблокированные

Ранг: Прохожий

Сообщений: 8

Репутация: 1 ±

Замечаний: 20% ±

Excel 2010

Вылетает на строчке
[vba]

Код

.Cells(Rows.Count, 1).End(xlUp)(2, 1).PasteSpecial Paste:=xlPasteValues

[/vba]
C ошибкой
Run time error 1004
Для этого все обьединенные ячейки должны иметь одинаковый размер

kaef.

Ответить

Manyasha

Дата: Четверг, 06.04.2017, 12:09 | Сообщение № 4

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация: 902 ±

Замечаний: 0% ±

Excel 2010, 2016

wemaxie, вот поэтому, нужно прикладывать файл! В правилах форума об этом сказано, замечание Вам.

ЯД: 410013299366744 WM: R193491431804

Ответить

wemaxie

Дата: Четверг, 06.04.2017, 12:11 | Сообщение № 5

Группа: Заблокированные

Ранг: Прохожий

Сообщений: 8

Репутация: 1 ±

Замечаний: 20% ±

Excel 2010

Цитата Manyasha, 06.04.2017 в 12:09, в сообщении № 4 ()

нужно прикладывать файл!

Не могу, т.к. на работе стоит запрет доступа к локальным файлам.

kaef.

Ответить

ОлеггелО

Дата: Четверг, 06.04.2017, 12:51 | Сообщение № 6

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 129

Репутация: 20 ±

Замечаний: 0% ±

wemaxie, а вы попробуйте добавить к коду показанному nilem, этот код (записан макрорекордером [vba]

Код

Cells.Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.UnMerge

[/vba]

В подобных случаях мне помогало. Этот код объединяет все ячейки на листе.

Сообщение отредактировал ОлеггелО - Четверг, 06.04.2017, 13:11

Ответить

Макрос выделения неопределнной области (Макросы/Sub)

Страница 1 из 1
1