n00bsteam |
Дата: Среда, 28.05.2014, 00:33 |
Сообщение № 1 |
|
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация:
0
±
Замечаний:
0% ±
Excel 2007 | |
Добрый день,есть список (порядка 4к строк) и необходимо каждую строчку,скопировать в новый созданный лист в определенные ячейки.
Пример: есть список ФИО (3 столбца) надо скопировать каждую строчку в новый лист в виде визитки\пропуска.
Возможно ли это сделать макросом?
Заранее спасибо за совет\помощь\пример!
Добрый день,есть список (порядка 4к строк) и необходимо каждую строчку,скопировать в новый созданный лист в определенные ячейки.
Пример: есть список ФИО (3 столбца) надо скопировать каждую строчку в новый лист в виде визитки\пропуска.
Возможно ли это сделать макросом?
Заранее спасибо за совет\помощь\пример! n00bsteam
Сообщение отредактировал n00bsteam - Среда, 28.05.2014, 00:45 |
|
| Ответить
|
Rioran |
Дата: Воскресенье, 08.06.2014, 01:19 |
Сообщение № 2 |
|
Группа: Авторы
Ранг: Ветеран
Сообщений: 903
Репутация:
290
±
Замечаний:
0% ±
Excel 2013 | |
n00bsteam, здравствуйте.
Можно сделать, как в файле, например. Для просмотра жмите кнопку "Пуск" внутри.
[vba]Код Sub Card_Manager()
With ThisWorkbook.Sheets(1)
Dim X As Long 'Для перебора имён в списке Dim rngX As Range 'Для работы с визитками
Set rngX = ThisWorkbook.Sheets(2).[A1:E5]
For X = 2 To .Cells(Rows.Count, 1).End(xlUp).Row rngX.Copy rngX.Offset(5 * (X - 1), 0).Select ActiveSheet.Paste rngX.Offset(5 * (X - 1), 0).Cells(3, 3).Value = .Cells(X, 1).Value rngX.Offset(5 * (X - 1), 0).Cells(3, 4).Value = .Cells(X, 2).Value rngX.Offset(5 * (X - 1), 0).Cells(4, 3).Value = .Cells(X, 3).Value Next X
Application.CutCopyMode = False
End With End Sub [/vba] [offtop]Для общего удобства просьба в следующий раз прикладывать свои собственные файлы.[/offtop]
n00bsteam, здравствуйте.
Можно сделать, как в файле, например. Для просмотра жмите кнопку "Пуск" внутри.
[vba]Код Sub Card_Manager()
With ThisWorkbook.Sheets(1)
Dim X As Long 'Для перебора имён в списке Dim rngX As Range 'Для работы с визитками
Set rngX = ThisWorkbook.Sheets(2).[A1:E5]
For X = 2 To .Cells(Rows.Count, 1).End(xlUp).Row rngX.Copy rngX.Offset(5 * (X - 1), 0).Select ActiveSheet.Paste rngX.Offset(5 * (X - 1), 0).Cells(3, 3).Value = .Cells(X, 1).Value rngX.Offset(5 * (X - 1), 0).Cells(3, 4).Value = .Cells(X, 2).Value rngX.Offset(5 * (X - 1), 0).Cells(4, 3).Value = .Cells(X, 3).Value Next X
Application.CutCopyMode = False
End With End Sub [/vba] [offtop]Для общего удобства просьба в следующий раз прикладывать свои собственные файлы.[/offtop]Rioran
Роман, Москва, voronov_rv@mail.ru Яндекс-Деньги: 41001312674279
Сообщение отредактировал Rioran - Воскресенье, 08.06.2014, 01:19 |
|
| Ответить
|