Перенесение ячеек жирного шрифта в Л2

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

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

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенесение ячеек жирного шрифта в Л2 (Макросы Sub)

NikiBarselona

Дата: Воскресенье, 05.01.2014, 14:22 | Сообщение № 1

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

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

Сообщений: 3

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

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

Excel 2007

Здравствуйте!Очень нужна помощь этого форума.Пишу макрос, который копирует только ячейки, выделенные полужирным шрифтом, и вставляет их из Листа1 в Лист 2
Кое-что набрасала, но это неверно.Помогите пожалуйста довести до ума)
[vba]

Код

Sub Макрос1()
'
' Макрос1 Макрос
'
ActiveCell.Select
If (Selection.Font.Bold = True) Then
Range("A1:B2").Select
Selection.Copy
Sheets("Лист2").Select
End If
Range("A1:B2").Select
ActiveSheet.Paste
End Sub

[/vba]

КавГульнара

Сообщение отредактировал Serge_007 - Воскресенье, 05.01.2014, 20:06

Ответить

KuklP

Дата: Воскресенье, 05.01.2014, 17:46 | Сообщение № 2

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

Ранг: Старожил

Сообщений: 2369

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

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

2003-2010

Поможем, не вопрос. Но для начала прочтите Правила и выложите пример. Время пошло.

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

NikiBarselona

Дата: Вторник, 07.01.2014, 20:20 | Сообщение № 3

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

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

Сообщений: 3

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

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

Excel 2007

вот файл,этот же макрос в 1 сообщении

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

КавГульнара

Ответить

wild_pig

Дата: Вторник, 07.01.2014, 22:57 | Сообщение № 4

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

Ранг: Обитатель

Сообщений: 517

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

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

2003, 2013

Так что вставить то

? Второй лист пустой. Переносить когда в обоих ячейках строки жирный шрифт или в одной?

Ответить

alex1248

Дата: Вторник, 07.01.2014, 23:30 | Сообщение № 5

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

Ранг: Обитатель

Сообщений: 384

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

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

Excel 2007, 2010

NikiBarselona, попробуйте это, хотя у меня опыт небольшой, но должно работать, если я правильно понял, что нужно.
[vba]

Код

Sub KopyZhyr()
     Dim InputRange As Range, Cell As Range, KopyStr As Long, KopyStolb As Long

     ActiveWorkbook.Worksheets("Лист1").Select
     Set InputRange = ActiveSheet.UsedRange

     For Each Cell In InputRange
         If Cell.Font.Bold = True Then
             KopyStolb = Cell.Column
             KopyStr = Cell.Row
             Sheets("Лист2").Cells(KopyStr, KopyStolb).Value = Cells(KopyStr, KopyStolb).Value

         End If
     Next Cell
End Sub

[/vba]