Блог

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

Вот что я сейчас использую:

 Option Explicit

Sub Test()

Dim Cell As Range

With Sheets(7)
    ' loop column H untill last cell with value (not entire column)
    For Each Cell In .Range("D1:D" amp; .Cells(.Rows.Count, "D").End(xlUp).Row)
        If Cell.Value = "Fail" Then
             ' Copy>>Paste in 1-line (no need to use Select)
            .Rows(Cell.Row).Copy Destination:=Sheets(2).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next Cell
End With

End Sub
 

Мне необходимо:

1. Вытяните строку, в которой есть ячейка, содержащая «Сбой».
2. Скопируйте строку в мастер, начиная с строки 4 и последовательно вниз без перезаписи
3. Запустите все листы сразу- *(они называются на каждом шаге установки — нужно ли мне переименовывать в «лист1, лист2 и т. Д.»????)
4. При запуске макроса очистите предыдущие результаты (чтобы избежать дублирования)

Другой пользователь предложил мне макрос автофильтра, но он не работает на 1004 в этой строке «.АвтоФильтр 4, «Сбой»»

 Sub Filterfail()

Dim ws As Worksheet, sh As Worksheet
Set sh = Sheets("Master")

Application.ScreenUpdating = False
        
        'sh.UsedRange.Offset(1).Clear  'If required, this line will clear the Master sheet with each transfer of data.
        
        For Each ws In Worksheets
                If ws.Name <> "Master" Then
                        With ws.[A1].CurrentRegion
                                .AutoFilter 4, "Fail"
                                .Offset(1).EntireRow.Copy sh.Range("A" amp; Rows.Count).End(3)(2)
                                .AutoFilter
                        End With
                End If
        Next ws

Application.ScreenUpdating = True

End Sub

 

Попробуйте это:

Текст “Completed” в этом xRStr = "Completed" сценарии указывает конкретное условие, на основе которого вы хотите копировать строки;

C:C в этом Set xRg = xWs.Range("C:C") сценарии указывается конкретный столбец, в котором находится условие.

 Public Sub CopyRows()

Dim xWs As Worksheet
Dim xCWs As Worksheet
Dim xRg As Range
Dim xStrName As String
Dim xRStr As String
Dim xRRg As Range
Dim xC As Integer

On Error Resume Next

Application.DisplayAlerts = False

xStr = "New Sheet"
xRStr = "Completed"
Set xCWs = ActiveWorkbook.Worksheets.Item(xStr)
If Not xCWs Is Nothing Then
    xCWs.Delete
End If
Set xCWs = ActiveWorkbook.Worksheets.Add
xCWs.Name = xStr
xC = 1

For Each xWs In ActiveWorkbook.Worksheets
    If xWs.Name <> xStr Then

        Set xRg = xWs.Range("C:C")
        Set xRg = Intersect(xRg, xWs.UsedRange)

        For Each xRRg In xRg
            If xRRg.Value = xRStr Then
               xRRg.EntireRow.Copy
               xCWs.Cells(xC, 1).PasteSpecial xlPasteValuesAndNumberFormats
               xC = xC   1
            End If

        Next xRRg
    End If
Next xWs

Application.DisplayAlerts = True

End Sub
 

Вот еще один способ — вам придется назначить свои собственные листы — я использовал 1 и 2, а не 2 и 7

 Sub Test()
   Dim xRow As Range, xCel As Range, dPtr As Long
   Dim sSht As Worksheet, dSht As Worksheet
   
   ' Assign Source amp; Destination Sheets - Change to suit yourself
     Set sSht = Sheets(2)
     Set dSht = Sheets(1)
   ' Done
   
   dPtr = Sheets(1).Rows.Count
   dPtr = Sheets(1).Range("D" amp; dPtr).End(xlUp).Row
   
   For Each xRow In sSht.UsedRange.Rows
      Set xCel = xRow.Cells(1, 1)                 ' xCel is First Column in Used Range (May not be D)
      Set xCel = xCel.Offset(0, 4 - xCel.Column)  ' Ensures xCel is in Column D
      If xCel.Value = "Fail" Then
         dPtr = dPtr   1
         sSht.Rows(xCel.Row).Copy Destination:=dSht.Rows(dPtr)
      End If
   Next xRow
End Sub
 

Я думаю, что одна из проблем в вашем собственном коде связана с этой строкой

     .Rows(Cell.Row).Copy Destination:=Sheets(2).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
 

Строки раздела.Подсчет, «А» должно относиться к целевому листу(2), но не из-за строки

 With Sheets(7)
 

дальше вверх