Сообщество Чайников

Вопрос

Есть таблица, в которой первая строка представляет шапку ФИО, Номер тел, и т.д, а дальше идет список из 80 человек по одной строке на каждого. Мне нужно как-то сделать, чтобы оно делало на другом листе что-то типа отдельной таблички на каждого человека, шапку переводило в вертикальный вид и вставляло нужные значения (не формулы, а именно вычесленные значения) из ячеек основной таблицы. Чтобы было понятнее, мне приходит екселевский файл от провайдера мобильной связи по корпоративным телефонам, где указано все детально: абонплата, разговоры в сети, исходящие, входящие, СМС и прочая ерунда. В екселе этих колонок от D до AB. Каждый раз делать это самому на 80 человек — 3 дня работы. Может можно как-то автоматизировать.

Ответ

Sub ManyToIndividual()
Dim iRow As Long iRow = 2 Dim ws As Worksheet
Set ws = Application.Worksheets(1)
Do While Not ws.Cells(iRow, 1).Text = "" Dim nws As Worksheet
If Application.Worksheets.Count >= iRow
Then Set nws = Application.Worksheets(iRow)
Else Set nws = Application.Worksheets.Add(After:=Application.Worksheets(Application.Worksheets.Count))
End
If nws.Cells.ClearContents Dim iCol
As Long iCol = 1
Do While Not
ws.Cells(1, iCol).Text = "" nws.Cells(iCol, 1).Value = ws.Cells(1, iCol).Value nws.Cells(iCol, 2).Value = ws.Cells(iRow, iCol).Value iCol = iCol + 1
Loop iRow = iRow + 1
Loop
End Sub

Из конференции Expert_FAQ