Макрос, который ищет определенный знак и ...

@Михря · Регистрация: 28.12.2010

Студворк — интернет-сервис помощи студентам

Блин, как сделать чтобы макрос искал в столбце любой знак и если находил копировал строку на другую страницу с вставкой строки.
Написал вот такую фигню не работает почему то ?
Private Sub CommandButton2_Click()

Worksheets('Список').Range('a3').Select
If ActiveCell = '' Then
GoTo Next1
Else: GoTo Copy1

Next1:
Worksheets('Список').ActiveCell.Cells(, 1).Activate
If ActiveCell = 'a10' Then
GoTo EndSeach
Else: GoTo Next1

If ActiveCell = '' Then
GoTo Next1
Else: GoTo Copy1

Copy1:
ActiveCell.Offset(0, 2).Activate
ActiveCell.Copy
Worksheets('Запрос').Activate
Worksheets('Запрос').Range('A8').EntireR ow.Insert
Worksheets('Запрос').Range('B8').Activat e
ActiveSheet.Paste

GoTo Next1

EndSeach:
MSbox = 'Скопированно!'
End If
End If
End If
End Sub

@XPraptor · 28.12.2010, 17:45

Да наваял ты тут. Вот держи код:

Dim i& 'Типа строки
Dim curRow& 'Типа строки для второго листа
Dim curCol& 'Типа столбцы для второго листа

curRow = 8
curCol = 1
For i = 3 To 10
If Worksheets('Список').cells(i, 1).Value <> '' Then
Worksheets('Запрос').cells(curRow, curCol).Value = Worksheets('Список').cells(i, 1).Value
curCol = curCol + 1
End If
Next i

@Михря · 30.12.2010, 11:46 **[ТС]**

Круто спасибо!
Но есть трудность.

Private Sub CommandButton2_Click()
Dim c As Range
Worksheets('Список').Range('J1:J100').Se lect
For Each c In Selection.Cells
For i = 1 To Len(c.Value)
If Mid(c.Value, i, 1) = '5' Then
f = f + 1
Rows(c.Row).Copy
Worksheets('Запрос').Activate
Worksheets('Запрос').Rows(f).EntireRow.I nsert
Worksheets('Список').Activate
End If
Next
Next

Но мне нужно скопировать на листе «Список» диапазон ячеек B$;F$ и вставить на лист «Запрос» в строки B7;F7 а все что уже скопировалось перемещалось на одну строку вниз.

Новые блоги и статьи Все статьи Все блоги /
Отправка уведомления на почту при изменении наименования справочника Maks 24.03.2026 Программная отправка письма электронной почты на примере изменения наименования справочника "Склады" в конфигурации БП3. Перед реализацией необходимо выполнить настройку системной учетной записи. . .	модель ЗдравоСохранения 5. Меньше увольнений- больше дохода! anaschu 24.03.2026 Теперь система здравосохранения уменьшает количество увольнений. 9TO2GP2bpX4 a42b81fb172ffc12ca589c7898261ccb/ https:/ / rutube. ru/ video/ a42b81fb172ffc12ca589c7898261ccb/ Слева синяя линия -. . .	Midnight Chicago Blues kumehtar 24.03.2026 Такой Midnight Chicago Blues, знаешь?. . Когда вечерние улицы становятся ночными, а ты не можешь уснуть. Ты идёшь в любимый старый бар, и бармен наливает тебе виски. Ты смотришь на пролетающие. . .	Контроль уникальности заводского номера - вариант №2 Maks 24.03.2026 В отличие от предыдущего варианта добавлено прерывание циклов, также добавлены новые переменные для сохранения контекста ошибки перед прерыванием цикла: Процедура ПередЗаписью(Отказ, РежимЗаписи,. . .
SDL3 для Desktop (MinGW): Вывод текста со шрифтом TTF с помощью библиотеки SDL3_ttf на Си и C++ 8Observer8 24.03.2026 Содержание блога Финальные проекты на Си и на C++: finish-text-sdl3-c. zip finish-text-sdl3-cpp. zip	Жизнь в неопределённости kumehtar 23.03.2026 Жизнь — это постоянное существование в неопределённости. Например, даже если у тебя есть список дел, невозможно дойти до точки, где всё окончательно завершено и больше ничего не осталось. В принципе,. . .	Модель здравоСохранения: работники работают быстрее после её введения. anaschu 23.03.2026 geJalZw1fLo Корпорация до введения программа здравоохранения имела много невыполненных работниками заданий, после введения программы количество заданий выросло. Но на выплатах по больничным это. . .	Контроль уникальности заводского номера - вариант №1 Maks 23.03.2026 Алгоритм контроля уникальности заводского (или серийного) номера на примере документа выдачи шин для спецтехники с табличной частью в конфигурации КА2. Данные берутся из регистра сведений, по. . .

@Михря 0 / 0 / 0 Регистрация: 28.12.2010 Сообщений: 26

	Макрос, который ищет определенный знак и ... 28.12.2010, 16:44. Показов 955. Ответов 2 Метки нет (Все метки) Блин, как сделать чтобы макрос искал в столбце любой знак и если находил копировал строку на другую страницу с вставкой строки. Написал вот такую фигню не работает почему то ? Private Sub CommandButton2_Click() Worksheets('Список').Range('a3').Select If ActiveCell = '' Then GoTo Next1 Else: GoTo Copy1 Next1: Worksheets('Список').ActiveCell.Cells(, 1).Activate If ActiveCell = 'a10' Then GoTo EndSeach Else: GoTo Next1 If ActiveCell = '' Then GoTo Next1 Else: GoTo Copy1 Copy1: ActiveCell.Offset(0, 2).Activate ActiveCell.Copy Worksheets('Запрос').Activate Worksheets('Запрос').Range('A8').EntireR ow.Insert Worksheets('Запрос').Range('B8').Activat e ActiveSheet.Paste GoTo Next1 EndSeach: MSbox = 'Скопированно!' End If End If End If End Sub 0

@XPraptor 0 / 0 / 3 Регистрация: 28.01.2010 Сообщений: 279
	28.12.2010, 17:45
	Да наваял ты тут. Вот держи код: Dim i& 'Типа строки Dim curRow& 'Типа строки для второго листа Dim curCol& 'Типа столбцы для второго листа curRow = 8 curCol = 1 For i = 3 To 10 If Worksheets('Список').cells(i, 1).Value <> '' Then Worksheets('Запрос').cells(curRow, curCol).Value = Worksheets('Список').cells(i, 1).Value curCol = curCol + 1 End If Next i 0

@Михря 0 / 0 / 0 Регистрация: 28.12.2010 Сообщений: 26
	30.12.2010, 11:46 [ТС]
	Круто спасибо! Но есть трудность. Private Sub CommandButton2_Click() Dim c As Range Worksheets('Список').Range('J1:J100').Se lect For Each c In Selection.Cells For i = 1 To Len(c.Value) If Mid(c.Value, i, 1) = '5' Then f = f + 1 Rows(c.Row).Copy Worksheets('Запрос').Activate Worksheets('Запрос').Rows(f).EntireRow.I nsert Worksheets('Список').Activate End If Next Next Но мне нужно скопировать на листе «Список» диапазон ячеек B$;F$ и вставить на лист «Запрос» в строки B7;F7 а все что уже скопировалось перемещалось на одну строку вниз. 0