Страницы: 1
RSS
Макрос переноса строк по условию после шапки
 
Здравствуйте. Прошу помощи. Самому мне не написать т к уже за 50 и закончил только школу.
А сейчас появилась такая необходимость.  Нашол вот такой макрос он переносит строки
по условию с Листа1 на Лист2 но шапка на Листе2 проподает т к он вставляет с первой строки.
И приходится каждый раз делать шапку. Может можно этот макрос как то подправить.
С уважением

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
 
Код
Sub Perenos()
Dim s&, i&, Txt$, b&
Txt = "True"
With Лист2
    s = .UsedRange.Row + .UsedRange.Rows.Count
    .Range(.Cells(5, 1), .Cells(s, 9)).ClearContents
End With
b = 4
With Лист1
    s = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 2 To s
        If .Cells(i, 1) = Txt Then
            b = b + 1
            Лист2.Range(Лист2.Cells(b, 1), Лист2.Cells(b, 9)) = .Range(.Cells(i, 1), .Cells(i, 9)).Value
        End If
    Next i
End With
MsgBox "Данные перенесены", vbInformation, "Выполнено"
End Sub

Во вложении пример.
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.
 
Код
Sub qq()
   Application.ScreenUpdating = False
   x = "True"
   If Sheets("Лист1").[A:A].Find(x) Is Nothing Then Exit Sub
        Sheets("Лист1").Activate
        Sheets("Лист1").[A:A].ColumnDifferences([A:A].Find(x)).EntireRow.Hidden = True
        Sheets("Лист1").UsedRange.SpecialCells(xlCellTypeVisible).Copy Sheets("Лист2").[A5]
        Sheets("Лист1").[A:A].EntireRow.Hidden = False
        Sheets("Лист2").Activate
Application.ScreenUpdating = True
  End Sub
Изменено: evgen032 - 16.10.2019 07:42:54
 
evgen032, посмотрите, как оформлен код в #2 - вот и Вы оформляйте так же: ищите такую кнопку (см. скрин) и исправьте своё сообщение.
Djo, аналогично следует поступить и Вам.
 
Всем большое спасибо за помощь .Юрий М Я же писал что самому мне не зделать
т к я в этом ничего не понимаю .Еще раз БОЛЬШОЕ БОЛЬШОЕ СПАСИБО
 
Djo, в сообщении нужно код оформить  как положено. Для этого особые знания не нужны.
Посмотрите на макросы в Вашем заглавном и в сообщениях ниже. Есть различия?
Страницы: 1
Наверх