Скопировать выбранные столбцы через промежуток

Старая форма входа

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

Скопировать выбранные столбцы через промежуток (Макросы/Sub)

TEjgruig1jk

Дата: Пятница, 28.10.2022, 10:12 | Сообщение № 1

Группа: Пользователи

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

Сообщений: 6

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

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

Добрый день!
Подскажите как прописать в коде копирование столбцов выборочно.
Дело в том что таких столбцов около 100 шт.
Определенной логики нет к которому моно привязать цикл (имхо)Книга1.xlsx

К сообщению приложен файл: 8597948.xlsm (10.3 Kb)

Сообщение отредактировал TEjgruig1jk - Пятница, 28.10.2022, 11:06

Ответить

Kuzmich

Дата: Пятница, 28.10.2022, 12:08 | Сообщение № 2

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

Ранг: Ветеран

Сообщений: 713

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

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

Excel 2003

Цитата

Определенной логики нет

пронумеруйте столбцы на листе1 в первой строке от 1 до 17 (от А до Q)
Создайте Лист2 и в первой строке введите номера тех столбцов,
которые вы желаете скопировать (А1=9, В1=12, С1=15 и т.д.)
При активном Листе1 запустить макрос
[vba]

Код

Sub iSelCopy()
Range(Cells(1, 1), Cells(28, 17)).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ThisWorkbook.Worksheets("Лист2").Range("A1").Resize(, 4), Unique:=False
End Sub

[/vba]

Ответить

TEjgruig1jk

Дата: Пятница, 28.10.2022, 12:22 | Сообщение № 3

Группа: Пользователи

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

Сообщений: 6

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

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

Kuzmich, все сделал не получилось вот файл

К сообщению приложен файл: 6901409.xlsm (17.2 Kb)

Ответить

TEjgruig1jk

Дата: Пятница, 28.10.2022, 12:32 | Сообщение № 4

Группа: Пользователи

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

Сообщений: 6

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

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

Kuzmich, а можно ли это реализовать циклом? просто немогу понять как в цикле прописать список диапазонов I13:I28 ; I13L:L28; O13:O28 ...итп 100 раз

Ответить

Kuzmich

Дата: Пятница, 28.10.2022, 12:35 | Сообщение № 5

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

Ранг: Ветеран

Сообщений: 713

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

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

Excel 2003

Ваш файл серьезно поврежден.

К сообщению приложен файл: 8597948_1.xlsm (17.8 Kb)

Ответить

TEjgruig1jk

Дата: Пятница, 28.10.2022, 12:41 | Сообщение № 6

Группа: Пользователи

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

Сообщений: 6

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

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

Kuzmich, прикрепил файл без макроса

К сообщению приложен файл: __.xlsx (11.2 Kb)

Ответить

TEjgruig1jk

Дата: Пятница, 28.10.2022, 13:02 | Сообщение № 7

Группа: Пользователи

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

Сообщений: 6

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

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

Kuzmich, возможно ли в коде в этом коде прописать список диапазонов (типа Range(" I13:I28 ; I13L:L28; O13:O28 ");

[vba]

Код

Sub Test3()
'Объявляем переменную
Dim myRange As Range
'Присваиваем диапазон ячеек
Set myRange = Range("C6:E8")
'Присваиваем ячейкам рабочего листа
'значения ячеек переменной диапазона
Range("A1:C3") = myRange.Value
MsgBox "Пауза"
'Копирование диапазона переменной
'и вставка его на рабочий лист
'с указанием начальной ячейки
myRange.Copy Range("E1")
MsgBox "Пауза"
'Копируем и вставляем часть
'диапазона из переменной
myRange.Range("A2:C2").Copy Range("E11")
End Sub

[/vba]

Сообщение отредактировал Serge_007 - Пятница, 28.10.2022, 13:27

Ответить

Kuzmich

Дата: Пятница, 28.10.2022, 13:12 | Сообщение № 8

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

Ранг: Ветеран

Сообщений: 713

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

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

Excel 2003

Цитата

а можно ли это реализовать циклом?

[vba]

Код

Sub iCopySelColumns()         'запускаем при активном листе Лист1
Dim i As Long
Dim n As Integer
Dim iLastRow As Long
Dim arr
Dim iCol As Range
  arr = Array(9, 12, 15, 17)    'выбранные столбцы
  n = 1
With Worksheets("Лист2")
   .Cells.Clear
For i = 0 To UBound(arr)
     Set iCol = Rows(1).Find(arr(i), , xlValues, xlWhole)
   If Not iCol Is Nothing Then
     Range(Cells(1, iCol.Column), _
     Cells(28, iCol.Column)).Copy .Cells(1, n)
     n = n + 1
   End If
Next i
.Activate
End With
End Sub

[/vba]