Versucht, Zeilen nach unten zu verschieben, um Leerzeichen zwischen Daten in Excel hinzuzufügen VBA

Question

DateSort = Cells(Cells.Rows.Count, "B").End(xlUp).Row 

For currentDate = 2 To DateSort 
    If Range("B" & currentDate) <> Range("B" & currentDate + 1) Then 
     currentDate = currentDate + 1 
     myRange = "A" & currentDate & ":" & "Q" & DateSort 
     Range(myRange).Select 
     Selection.Copy 
     Selection.Clear 
     myNewRange = "A" & currentDate + 1 
     Range(myRange).PasteSpecial 
     Selection.PasteSpecial 

    End If 

Next 

Ich habe Daten in Spalte "B" meines Arbeitsblatts. Ich würde gerne eine leere Zeile zwischen jeder Gruppe von Daten setzen. (Sie sind bereits sortiert)

Derzeit sucht mein Code nach einem neuen Datum, wählt den Rest der Daten aus, kopiert und löscht die Daten, schlägt jedoch fehl, wenn er in den neuen Bereich eingefügt wird.

Answer 1

Ich habe versucht, Ihre Logik zu ändern, damit es funktioniert, aber selbst jetzt gibt es einen Fehler, weil Ihr Code nicht gut geschrieben ist. Wenn es viele verschiedene Daten gibt, haben die letzten Daten keinen Abstand.

datesort = Cells(Cells.Rows.Count, "B").End(xlUp).Row 

For currentDate = 2 To datesort 
    If Range("B" & currentDate) <> Range("B" & currentDate + 1) Then 
     currentDate = currentDate + 1 
     myRange = "A" & currentDate & ":" & "Q" & datesort 
     Range(myRange).Select 
     Selection.Copy 
     'Selection.Clear 
     myNewRange = "A" & currentDate + 1 
     Range(myNewRange).PasteSpecial 
     Range("B" & currentDate).Clear 
     'Selection.PasteSpecial 
     datesort = datesort + 1 
    End If 

Next 

Hier ist eine andere Version des Codes mit großen Veränderung, aber es funktioniert perfekt

datesort = Cells(Cells.Rows.Count, "B").End(xlUp).Row 

For currentdate = 2 To datesort * 2 
    If Range("B" & currentdate) <> Range("B" & currentdate + 1) Then 
     Range(Range("B" & currentdate + 1), Range("B" & currentdate + 1).End(xlDown)).Select 

     If Selection.Cells.Count < 20000 Then 
      currentdate = currentdate + 1 
      Selection.Copy 
      Selection.Offset(1, 0).Select 
      Selection.PasteSpecial 
      Range("B" & currentdate).Clear 
     End If 

    End If 

Next