Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 24.07.2015, 13:20   #1
Laprion
Новичок
Джуниор
 
Регистрация: 24.07.2015
Сообщений: 2
По умолчанию Перенос определенных строк на другой лист

Добрый день! Задача следующая: нужно перенести с первого листа на второй только определенные строки. Например только те, в которых в столбце А есть значение 850000010248. Все что получилось в прикрепленном файле. И это не работает. Помогите, пожалуйста, разобраться в чем ошибка?
Вложения
Тип файла: xls 1.xls (37.5 Кб, 36 просмотров)
Laprion вне форума Ответить с цитированием
Старый 24.07.2015, 15:34   #2
27102014
Форумчанин
 
Регистрация: 27.10.2014
Сообщений: 248
По умолчанию

Код:
Sub test()
Sheets("Лист2").Select
Cells.ClearContents
    
Sheets("Лист1").Select

lLastRow = Worksheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Row 
 For iRow& = 1 To lLastRow
  Sheets("Лист1").Select
  If Cells(iRow&, "A:A").Value = "850000010248" Then
     .Rows(iRow&).Copy
     Sheets("Лист2").Range("A" & Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row).Insert Shift:=xlDown

  End If
  
Next

Sheets("Лист2").Select

End Sub
27102014 вне форума Ответить с цитированием
Старый 24.07.2015, 19:24   #3
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Можно проще:
Код:
Sub qq()
    Dim rng As Range, x: Application.ScreenUpdating = False
    x = "850000010248" 'Это то, что будем искать
    If Sheets("Лист1").[A:A].Find(x) Is Nothing Then Exit Sub
    With Sheets("Лист2")
        .Cells.ClearContents
        Sheets("Лист1").UsedRange.Copy .[A1]
        .[A:A].ColumnDifferences(.[A:A].Find(x)).EntireRow.Delete
    End With
End Sub
Пример во вложении.
Вложения
Тип файла: rar 2.rar (12.2 Кб, 103 просмотров)
Чем шире угол зрения, тем он тупее.

Последний раз редактировалось SAS888; 25.07.2015 в 01:06.
SAS888 вне форума Ответить с цитированием
Старый 25.07.2015, 11:52   #4
Kapkom
Пользователь
 
Регистрация: 22.09.2014
Сообщений: 26
По умолчанию

Извините, пожалуйста, что вмешиваюсь в тему. У меня есть тоже вопрос по данной теме.
Начну сразу с примера.
Из Листа 1 надо переместить строки, в столбце A по которым указана цифра 1, на строки Листа 2, в столбце A по которым указана цифра 2.

Подскажите, пожалуйста, что надо в макросе прописать?

Заранее большое спасибо.
Kapkom вне форума Ответить с цитированием
Старый 25.07.2015, 12:26   #5
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Цитата:
Начну сразу с примера...
Где он (пример)?
А в тему и не нужно вмешиваться.
Создайте новую тему, подробно опишите задачу и прикрепите файл с исходными данными. Еще лучше, если Вы представите и желаемый результат работы макроса.
Только в этом случае Вы получите быстрый, а самое главное, точный ответ.
Чем шире угол зрения, тем он тупее.
SAS888 вне форума Ответить с цитированием
Старый 25.07.2015, 13:49   #6
Kapkom
Пользователь
 
Регистрация: 22.09.2014
Сообщений: 26
По умолчанию

Понял. Виноват. Исправлюсь.
Kapkom вне форума Ответить с цитированием
Старый 25.07.2015, 14:05   #7
Laprion
Новичок
Джуниор
 
Регистрация: 24.07.2015
Сообщений: 2
По умолчанию

Большое спасибо Вам за помощь, SAS888 и 27102014.
Немного подправил код и он заработал:
Код:
Sub test()
    Sheets("Книга2").Activate
    Sheets("Книга2").Range("A:M").Clear
    lLastRow = Worksheets("Книга1").Cells(Rows.Count, 1).End(xlUp).Row
    For iRow& = 1 To lLastRow
        Sheets("Книга1").Select
        If Cells(iRow&, "A:A").Value = "850000010248" Then
            Rows(iRow&).Copy
            Sheets("Книга2").Range("A" & Sheets("Книга2").Cells(Rows.Count, 1).End(xlUp).Row).Insert Shift:=xlDown
        End If
    Next
End Sub
Laprion вне форума Ответить с цитированием
Старый 10.12.2018, 17:20   #8
Nikita orlofskiy
Новичок
Джуниор
 
Регистрация: 10.12.2018
Сообщений: 1
Вопрос всем привет, помогите плиз , мне надо, чтоб после того, как скопирует удаляла скопированное

Цитата:
Сообщение от Laprion Посмотреть сообщение
Добрый день! Задача следующая: нужно перенести с первого листа на второй только определенные строки. Например только те, в которых в столбце А есть значение 850000010248. Все что получилось в прикрепленном файле. И это не работает. Помогите, пожалуйста, разобраться в чем ошибка?
Sub test()
Sheets("Лист1").Activate
llastrow = Worksheets("Лист1").Cells(Rows.coun t, 1).End(xlUp).Row
For iRow& = 1 To llastrow
Sheets("Лист1").Select
If Cells(iRow&, "A:A").Value = "" Then
Rows(iRow&).Copy
Sheets("Лист2").Range("A" & Sheets("Лист2").Cells(Rows.count,1) .End(xlUp).Row).Insert Shift:=xlDown - в этой строке ошибка помогите ришить
For i = llastrow To 1 Step -1
If Cells(i, 1).Value = "" Then _
Cells(i, 1).EntireRow.Delete
Next i
End If
Next
End Sub
Nikita orlofskiy вне форума Ответить с цитированием
Старый 13.10.2019, 20:27   #9
Djo68
Новичок
Джуниор
 
Регистрация: 13.10.2019
Сообщений: 1
По умолчанию

Здравствуйте Помогите пожалуйста Я вставил у себя этот макрос из 3 сообщения
Sub qq()
Dim rng As Range, x: Application.ScreenUpdating = False
x = "True" 'Это то, что будем искать
If Sheets("Лист1").[A:A].Find(x) Is Nothing Then Exit Sub
With Sheets("Лист2")
.Cells.ClearContents
Sheets("Лист1").UsedRange.Copy .[A1]
.[A:A].ColumnDifferences(.[A:A].Find(x)).EntireRow.Delete
End With
End Sub
Он вставляет в Лист2 со строчки A1 где идут названия столбцов и они проподают
Если можно сделайте пожалуйста чтоб он вставлял с A5 .А 4 верхние строчки будут под шапку
Djo68 вне форума Ответить с цитированием
Старый 14.10.2019, 00:41   #10
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

уважаемые дамы и господа
каждый макрос решает ОДНУ конкретную задачу
и если ВАША задача не соответствует этой конкретной задаче - он ее не решит.
забудьте об УНИВЕРСАЛЬНЫХ макросах, решающих ВСЕ ЗАДАЧИ, таких нет.
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Перенос данных на другой лист tgm Microsoft Office Excel 0 06.08.2012 21:43
перенос строк в другой лист по условию dzaymko Microsoft Office Excel 4 23.04.2012 12:16
Перенос данных на другой лист Palomnik1096 Microsoft Office Excel 5 20.12.2010 15:12
поиск и перенос на другой лист. artssp Microsoft Office Excel 34 01.12.2010 05:58
Автоматический перенос строк из одного листа в другой лист Результат maksvas Microsoft Office Excel 4 22.10.2010 14:03