Excel VBA Wählen Sie basierend auf Werten in einer Spalte aus, ob in die nächste leere Zeile übertragen oder eine leere Zeile zuerst belassen werden soll.

Question

Ich habe eine Arbeitsmappe, in der ein Arbeitsblatt "Arbeitsblatt" vorhanden ist, auf dem sich alle Produkte für ein Projekt befinden. Basierend auf der Delivery Stage-Spalte ("BF") werden sie dann in die richtigen Stage Sheets übertragen. Layout of the Worksheets. Stage worksheets go up to 24. 6-24 are hidden.

Die Produkte sind in Typen oder Gruppen desselben Produkts nicht nach der Stufe sortiert. Zwischen den verschiedenen Gruppen befinden sich leere Zeilen. Zur Zeit übergibt der Code, den ich habe, die Produkte an die richtigen Stufen, aber ohne Trennung zwischen den verschiedenen Produktgruppen. View of Master Sheet sorted by Product, not by Stage. Zum Beispiel; Zwischen D10 und D05 sollte eine leere Zeile stehen, da dies das nächste Produkt für Stufe 1 ist, aber nicht dasselbe wie D10.

Mein aktueller Code ist dies:

Sub LineCopy() 

RowClear.ClearRows 

Dim LR As Long, i As Long, x As Long, xLR As Long, y As Long 
LR = Sheets("Master Sheet").Range("A" & Rows.Count).End(xlUp).Row 

Application.ScreenUpdating = False 

For i = 10 To LR 
    For x = 1 To 24 
     If Sheets("Master Sheet").Range("BF" & i).Value = x Then 
      Sheets("Master Sheet").Range("A" & i).EntireRow.Copy 
      Sheets("Stage " & x & " Sheet").Range("A" &  Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues) 
     End If 
    Next x 
Next i 

Application.CutCopyMode = False 

End Sub 

Vielen Dank im Voraus für Ihre Hilfe.

Answer 1

Eine Lösung wäre hier, eine Spalte hinzuzufügen, die das Produkt/die Gruppierung angibt, dann können Sie einfach überprüfen, ob der Wert auf dem Masterblatt mit dem letzten Wert im Stage Sheet übereinstimmt.

Die andere Alternative besteht darin, zu verfolgen, ob Sie eine Zeile überspringen müssen. Angenommen, es ist möglich, mehrere Einträge für eine Bühne in einer Gruppe zu haben, müssen Sie dies separat für jedes Stage-Blatt mit einem Array verfolgen.

Sub LineCopy() 
    RowClear.ClearRows 

    Dim LR As Long, i As Long, x As Long, xLR As Long, y As Long 
    LR = Sheets("Master Sheet").Range("A" & Rows.Count).End(xlUp).Row 

    Application.ScreenUpdating = False 

    'Create an array to track whether each sheet needs to skip a line 
    'Default is False 
    Dim SkipLine(24) As Boolean 


    For i = 10 To LR 
     'Rather than looping twice, we will get the value of x from column BF 
     x = Sheets("Master Sheet").Range("BF" & i) 

     'If the cell is empty, x will be zero 
     If x = 0 Then 
      'We fill the array with the value of True every sheet 
      'They all need to skip a row now 
      For j = 1 To 24 
       SkipLine(j) = True 
      Next 
     Else 
      'If cell BF is not empty, we copy the row 
      Sheets("Master Sheet").Range("A" & i).EntireRow.Copy 
      'Find the empty cell at the bottom of the stage sheet 
      Set PasteRow = Sheets("Stage " & x & " Sheet").Range("A" & Rows.Count).End(xlUp).Offset(1) 
      'Check whether we need to skip a row for this Stage Sheet 
      If SkipLine(x) = True Then 
       'If we need to skip a row, offset the PasteRow variable by another row 
       Set PasteRow = PasteRow.Offset(1) 
       'Update the array to show that we no longer need to skip a line on this sheet 
       SkipLine(x) = False 
      End If 
      'Paste the data 
      PasteRow.PasteSpecial (xlPasteValues) 
     End If 
    Next i 

    Application.CutCopyMode = False 
End Sub