Новости:

К первому сообщению темы должен быть прикреплен файл примера в формате xls*.
Приложив пример, Вы избавите себя и других от вопросов типа "А какой критерий?", "А куда выводить результат?", "А сколько строк?" и все тех же просьб выложить файл. Рисовать за Вас Ваши же таблички с заданиями, а затем и решение к ним, никто желанием не горит. Да и, как показывает практика, в большинстве случаев без файла решения не найти.

Главное меню

Макрос создать колонку данных из ячеек в определённых строках

Автор Adar, 01.06.2011, 13:50

« назад - далее »

Adar

Добрый день,

существует лист1, на котором:
в строке1 находятся названия компаний
в строке3 числа

мне необходимо переносить их на другой лист так чтобы в колонке 1 было название компании, а в колонке 2 было соответствующее число из строки3.

Дополнительно: компании у меня разделены на группы (названия закрашены соответствующими цветами), хорошо бы сохранять эти цвета при создании таблицы из 2ух колонок на другом листе.

Спасибо

_Boroda_

Извиняй за временное удаление темы.
Перепутал.
Ответ во вложении.
Скажи мне, кудесник, любимец ба'гов...



Яндекс-деньги: 41001632713405
Webmoney: R289877159277; Z102172301748; E177867141995

Adar

спасибо, а как мне это дело перекинуть в другой файл?

я имею ввиду что скопировать модули в другой файл недостаточно ))

_Boroda_

Не совсем понял вопрос.
В другом файле вставляем такой макрос
Sub Макрос1()
Application.ScreenUpdating = 0
    c_ = Range("A1").SpecialCells(xlLastCell).Column
    Range("A1").Resize(3, c_).Copy
    sn_ = Worksheets.Add.Name
    With Sheets(sn_)
        .Range("A1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
        Application.CutCopyMode = False
        .Columns("B:B").Delete Shift:=xlToLeft
        .Range("B2").Delete Shift:=xlUp
        .Range("A1:A" & c_).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        .Range("A1").Select
    End With
Columns("A:B").EntireColumn.AutoFit
Application.ScreenUpdating = 1
End Sub

рисуем кнопку и вешаем а нее этот макрос
ии я что-то недоперепонял?
Скажи мне, кудесник, любимец ба'гов...



Яндекс-деньги: 41001632713405
Webmoney: R289877159277; Z102172301748; E177867141995

Adar

Цитата: _Boroda_ от 10.06.2011, 14:22
Не совсем понял вопрос.
В другом файле вставляем такой макрос
Sub Макрос1()
Application.ScreenUpdating = 0
    c_ = Range("A1").SpecialCells(xlLastCell).Column
    Range("A1").Resize(3, c_).Copy
    sn_ = Worksheets.Add.Name
    With Sheets(sn_)
        .Range("A1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
        Application.CutCopyMode = False
        .Columns("B:B").Delete Shift:=xlToLeft
        .Range("B2").Delete Shift:=xlUp
        .Range("A1:A" & c_).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        .Range("A1").Select
    End With
Columns("A:B").EntireColumn.AutoFit
Application.ScreenUpdating = 1
End Sub

рисуем кнопку и вешаем а нее этот макрос
ии я что-то недоперепонял?

я скопировал один в один, нажимаю запуск макроса открывается лист где появляются названия колонок но значений дальше нет. Где мне тут задать название листа с которого выборку данных делать, у меня там 10 листов...

Adar

Цитата: _Boroda_ от 14.06.2011, 16:19
Макрос берет данные из активного листа. Короче - файл с непонятками и хочушками где?
раз с активного то оставил три листа (иначе не влезет на форум) и захват данных должен идти с листа data.

И можно чтобы макрос не создавал новый лист а кидал всё на лист "sort risk"?

Спасибо

_Boroda_

А почему в первом примере в строке 3 значения, а во втором примере - формулы? Тогда другой тип вставки
Скажи мне, кудесник, любимец ба'гов...



Яндекс-деньги: 41001632713405
Webmoney: R289877159277; Z102172301748; E177867141995

Adar

как то не подумал что это имеет значение, спасибо! :)

Adar

Можно сделать так чтобы в дополнение к этому в третью колонку выносились значения из ячеек 4 строки колонок B, D, F и так далее через одну. Там тоже функция.

_Boroda_

Немного поменяем 5 и 8 строки макроса. Кстати, 8 строку и в старом макросе так и нужно было написать.
Sub Макрос1()
Dim c_, sn_
Application.ScreenUpdating = 0
   c_ = Range("A1").SpecialCells(xlLastCell).Column
   Range("A1").Resize(4, c_).Copy
   sn_ = "sort risk"
   With Sheets(sn_)
       .Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
       Application.CutCopyMode = False
       .Columns("B:B").Delete Shift:=xlToLeft
       .Range("B2").Delete Shift:=xlUp
       .Range("A1:A" & c_).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
   End With
Columns("A:B").EntireColumn.AutoFit
Application.ScreenUpdating = 1
End Sub
Скажи мне, кудесник, любимец ба'гов...



Яндекс-деньги: 41001632713405
Webmoney: R289877159277; Z102172301748; E177867141995

Adar

Хорошо работает, немного сам подкорретировал ещё чтобы не захватывалось слово Дисперсия, ато вводит в заблуждение :)