Макрос транспонирования

[Oleg778]

Доброго дня !

есть вопрос по макросу

1)Макрос транспонирования - как сделать для большего количества строк больше 260
Дело в том что проверил данный макрос - он транспонирует строки (но только до 259 строк-если больше ошибка вылазит) в столбцы в на новый лист
Почему так ? У меня диапазон A4:AH5003

Sub Макрос1()
Range("A4:AH5003").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Range("A1").Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True 
End Sub

ошибка в строке

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

ошибка Run-time error '1004'

файл прилагаю

2)Как сделать в этом макросе чтоб он переименовывал лист куда делается транспонирование ? переименовать лист в "Данные" например

[SAS888]

Это потому, что при транспонировании 5003 строк у Вас получится 5003 столбцов.
Это больше, чем 256, т. е. больше, чем допускает Excel 2003.
Измените формат на ".xlsm" и используйте более старшие версии Excel, где столбцов 16384.

[Oleg778]

Все равно ругается на эту строку. Пересохранил в EXCEL2010 в *.xlsm

[kuklp]

Сообщение от SAS888

.. используйте более старшие версии Excel, где столбцов 16384.

Сергей, это младшие версии

[kuklp]

Так работает.

Sub TRP()
    Range("A4:AH5003").Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.[A1].PasteSpecial Paste:=xlPasteAll, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub

[SAS888]

Теперь не вижу проблем:

Sub TRP()
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Ваше_Имя_Листа"
    Sheets("Таблица").Range("A4:AH5003").Copy
    ActiveSheet.[A1].PasteSpecial Transpose:=True
End Sub

[Oleg778]

Спасибо SAS888 и kuklp ! Заработало на *.xlsm (на *.xls не сработало) Еще один вопрос если можно - как переделать код чтобы сохранял данные транспонирования в отдельном 2 файле под названием Ваше_Имя_Файла (не на соседнем листе) в той же директории где лежит осн 1 файл ?

[SAS888]

Можно так:

Sub TRP()
    Workbooks.Add xlWBATWorksheet
    ActiveSheet.Name = "Ваше_Имя_Листа"
    ThisWorkbook.Sheets("Таблица").Range("A4:AH5003").Copy
    ActiveSheet.[A1].PasteSpecial Transpose:=True
    ActiveWorkbook.SaveAs "Ваше_Имя_Книги.xlsx"
End Sub

[Oleg778]

SAS888 все замечательно но как прикрепить путь сохранения правильно относительный в тойже директории или явно прописать

типа & "\" & Date & ".xlsm"

[SAS888]

Так и пишите.
Вместо строки

ActiveWorkbook.SaveAs "Ваше_Имя_Книги.xlsx"

Используйте, например,

ActiveWorkbook.SaveAs "C:\Temp\" & Date & ".xlsx"