Wenn und Do Bis Schleife EXCEL VBA

Question

Neu bei VBA, wenn mir jemand helfen könnte, was ich hier falsch mache. Der Versuch, eine Schleife so auszuführen, dass sie nach einem bestimmten Text sucht, startet die Schleife und stoppt dann an einem bestimmten Punkt. Die Schleifen sind so, dass ich es einige Werte unter in meinem Blatt kopieren will daher eine ist 55. Im den Fehlerblock gegenüber IF ohne End If

Hier ist der Code:

Private Sub CommandButton3_Click() 
For y = 1 To 15 Step 5 
Dim x As Double 
Dim a As Double 
x = 1 
a = 55 
If Cells(x, y).Value = "Text1" Then 
Do Until Cells(x, y).Value = "Text2" 
Cells(a, y) = Cells(x, y).Value 
Cells(a, y + 1) = Cells(x, y + 1) 
x = x + 1 
a = a + 1 


Loop 


End Sub 

Answer 1

Neben den Fragen, die ich erwähnte in die Kommentare zu Ihrem Beitrag, wenn ich Sie richtig verstanden habe, wollen Sie auf Zellen in der Spalte A Schleife, finden Sie die erste "Text1", dann kopieren Sie alle Zellen in Zeile 55 und darunter, bis Sie "Text2" finden. Wenn das der Fall ist, versuchen Sie den Code unten:

Private Sub CommandButton3_Click() 

Dim x As Long, y As Long 
Dim a As Long 
Dim LastRow As Long 

With Worksheets("Sheet1") '<-- modify "Sheet1" to your sheet's name 
    For y = 1 To 15 Step 5 

     x = 1 '<-- reset x and a (rows) inside the columns loop 
     a = 55 '<-- start pasting from row 55 

     LastRow = .Cells(.Rows.Count, y).End(xlUp).Row 
     While x <= LastRow '<-- loop until last row with data in Column y 
      If .Cells(x, y).Value Like "Text1" Then 
       Do Until .Cells(x, y).Value = "Text2" 
        .Cells(a, y).Value = .Cells(x, y).Value 
        .Cells(a, y + 1).Value = .Cells(x, y + 1).Value 
        x = x + 1 
        a = a + 1 
       Loop 
      End If 
      x = x + 1 
     Wend 
    Next y 
End With 

End Sub 

Answer 2

Einrücken ist der Weg nach vorne, haben Sie eine for Anweisung ohne next und ein if ohne End If:

Private Sub CommandButton3_Click() 
    For y = 1 To 15 Step 5 
     Dim x As Double 
     Dim a As Double 
     x = 1 
     a = 55 
     If Cells(x, y).Value = "Text1" Then 
      Do Until Cells(x, y).Value = "Text2" 
       Cells(a, y) = Cells(x, y).Value 
       Cells(a, y + 1) = Cells(x, y + 1) 
       x = x + 1 
       a = a + 1 
      Loop 
     End If 
    Next y 
end sub