Я не мог исправить Для каждой ячейки в диапазоне проблемы. Требуется помощь

Question

У меня есть возможность экспортировать информацию из столбцов A, B и D Листа 1 в столбцы A, B, C на Листе 2, если AE содержит 1. Я сделал следующий код из копирования со сайта stackoverflow. Копирует информацию со всех строк. Я просто хочу скопировать только те строки, которые содержат 1 в столбце AE. Мне нужна помощь. Спасибо.

    Dim wsht1 as worksheet
   Dim Wsht2 as worksheet
   Dim c as range
   Dim Myrng as range
   Dim i as long
   Dim lRw2  as long
   Dim lRw1 as long


  wsht1 = ActiveWorkbook
  wsht1  = sheet (2)

  With WsHT1
    lRw2 = .Cells(.rows.Count, "A").End(xlUp).Row
    End With

   Set Myrng = Wsht1.Range("AE3", "AE" & LRW1)
   With Wsht1

  For Each c In Myrng.rows
    For i = 4 To LRW1

    With WsHT2
    lRw2 = .Cells(.rows.Count, "A").End(xlUp).Row
    End With

        If c = 1 Then
            .Range("A" & i).Copy WsHT2.Range("A" & lRw2).Offset(1, 0)
            .Range("B" & i).Copy WsHT2.Range("B" & lRw2).Offset(1, 0)
            .Range("D" & i).Copy WsHT2.Range("C" & lRw2).Offset(1, 0)
        End If
        Next i
        Next c
    End With

   end sub

Answer 1

У меня есть возможность экспортировать информацию из столбцов A, B и D Листа 1 в столбцы A, B, C на Листе 2, если AE содержит 1. Я сделал следующий код из копирования со сайта stackoverflow. Копирует информацию со всех строк. Я просто хочу скопировать только те строки, которые содержат 1 в столбце AE. Мне нужна помощь. Спасибо.

    Dim wsht1 as worksheet
   Dim Wsht2 as worksheet
   Dim c as range
   Dim Myrng as range
   Dim i as long
   Dim lRw2  as long
   Dim lRw1 as long


  wsht1 = ActiveWorkbook
  wsht1  = sheet (2)

  With WsHT1
    lRw2 = .Cells(.rows.Count, "A").End(xlUp).Row
    End With

   Set Myrng = Wsht1.Range("AE3", "AE" & LRW1)
   With Wsht1

  For Each c In Myrng.rows

    With WsHT2
    lRw2 = .Cells(.rows.Count, "A").End(xlUp).Row
    End With

        If c = 1 Then
            C.offset(0,-30) Copy WsHT2.Range("A" & lRw2).Offset(1, 0)
            .C.offset(0,-29) Copy WsHT2.Range("A" & lRw2).Offset(1, 0)
C.offset(0,-27) Copy WsHT2.Range("A" & lRw2).Offset(1, 0)
Else
        End if
Next c
    End With

   end sub

Answer 2

Вот мой код:

Sub DataCopy()

    Debug.Print "RUNNING SOUBRUTINE"

    'Declarations.
    Dim WksWorksheet01 As Worksheet
    Dim WksWorksheet02 As Worksheet
    Dim RngTrigger As Range
    Dim RngDestination As Range
    Dim LngCounter01 As Long
    Dim RngTarget As Range
    Dim LngColumn01 As String
    Dim LngColumn02 As String
    Dim LngColumn03 As String

    Debug.Print "DECLARATIONS COMPLETED"

    'Setting variables.
    Set WksWorksheet01 = ActiveSheet 'better to give the specific sheet name here
    Set WksWorksheet02 = Sheets("Foglio2") 'better to give the specific sheet name here
    Set RngTrigger = WksWorksheet01.Range("AE3", WksWorksheet01.Cells(WksWorksheet01.Rows.Count, "AE").End(xlUp))
    Set RngDestination = WksWorksheet02.Range("A3")
    LngColumn01 = 1
    LngColumn02 = 2
    LngColumn03 = 4

    Debug.Print "VARIABLE SETTING COMPLETED"

    Debug.Print "REPORT"
    Debug.Print "WksWorksheet01.Name = "; WksWorksheet01.Name
    Debug.Print "WksWorksheet02.Name = "; WksWorksheet02.Name
    Debug.Print "RngTrigger.Address = "; RngTrigger.Address
    Debug.Print "RngTrigger count value = "; Excel.WorksheetFunction.CountA(RngTrigger)
    Debug.Print "RngTrigger sum = "; Excel.WorksheetFunction.Sum(RngTrigger)
    Debug.Print "RngDestination.Address = "; RngDestination.Address
    Debug.Print "-------------"

    'Covering the whole RngTrigger.
    For Each RngTarget In RngTrigger
        'Checking if RngTarget contains 1.
        Debug.Print "RngTarget.Address = "; RngTarget.Address
        Debug.Print "RngTarget.Value = "; RngTarget.Value
        Debug.Print "Equal to 1? "; RngTarget.Value = 1
        If RngTarget.Value = 1 Then
            Debug.Print "Copied in row "; LngCounter01 + 1
            Debug.Print "Pre-existing data? "; RngDestination.Offset(LngCounter01, 0).Value <> ""; RngDestination.Offset(LngCounter01, 1).Value <> ""; RngDestination.Offset(LngCounter01, 2).Value <> ""
            'Copying data.
            RngDestination.Offset(LngCounter01, 0).Value = RngTarget.Offset(0, LngColumn01 - RngTarget.column).Value
            RngDestination.Offset(LngCounter01, 1).Value = RngTarget.Offset(0, LngColumn02 - RngTarget.column).Value
            RngDestination.Offset(LngCounter01, 2).Value = RngTarget.Offset(0, LngColumn03 - RngTarget.column).Value
            'Setting LngCounter01 for the next row.
            LngCounter01 = LngCounter01 + 1
        End If
        Debug.Print "-"
    Next

    Debug.Print "COPING COMPLETED"

End Sub

Код, который вы разместили, не имел для меня особого смысла, поэтому я в основном создал новый. Я бы посоветовал вам указать имя листов при их установке. Я не считаю ActiveSheet и листы (2) действительно надежными (но я понимаю, что они могут быть необходимы). Скажите, работает ли он и / или если вам нужны какие-либо объяснения или улучшения.