Kopieren Sie Zeilen in bestimmte Blätter basierend auf Wert

Question

Frage mich, ob jemand könnte mich in die richtige Richtung bitte, wie ich bin verwirrt mit jeder Methode ich versuche. Ich habe viel nach einer Antwort gesucht, aber mein Szenario ist ein bisschen anders als andere, die ich gefunden habe.

Ich habe ein Arbeitsblatt mit einer Anzahl von Spalten und Überschriften für jede Spalte. Spalte A ist "Datum", Spalte B ist "Klassifizierung", Spalte C ist "Auswahl". Wenige weitere Spalten.

Was ich tun möchte, ist die Schleife durch das gesamte Blatt von A2 bis zur letzten Zeile Basis in Spalte C. Der Blick auf Spalte A für jeden Satz von Zeilen zu kopieren. Zwischen den Daten in Spalte A könnten leere Zeilen stehen. Für jeden Zeilensatz in Spalte A (Datum bis nächstes Datum -1 Zeile) möchte ich diesen Bereich oder die Zeilen in ein anderes Blatt basierend auf Spalte B kopieren.

Ich habe den Code geschrieben, um die Blätter zu entfernen, auf die in Spalte B verwiesen wird, und füge dann die Blätter hinzu und füge die Kopfzeilen hinzu. Hier

ist ein Beispiel: null mit leerer Zelle

+------------+----------------+------------+ 
| Date  | Classification | Selection | 
+------------+----------------+------------+ 
| 10/08/2017 | Chris   | Selection1 | 
+------------+----------------+------------+ 
| 11/08/2017 | Chris   | Selection2 | 
+------------+----------------+------------+ 
| null  | null   | Selection3 | 
+------------+----------------+------------+ 
| null  | null   | Selection4 | 
+------------+----------------+------------+ 
| 11/08/2017 | Speed   | Selection5 | 
+------------+----------------+------------+ 
| null  | null   | Selection6 | 
+------------+----------------+------------+ 
| null  | null   | Selection7 | 
+------------+----------------+------------+ 

Oberhalb gibt es 3 „Aufzeichnungen“, um anzuzeigen, die auf zwei Blätter kopiert werden müssen. 2 Bereiche zu Chris und 1 Bereich zu Speed. In Wirklichkeit habe ich Hunderte von "Aufzeichnungen", die auf 10 Blätter verschoben werden müssen. Im Grunde muss ich 2 Blätter für jeden Rekord aktuell aktualisieren und ich möchte nur einen Master aktualisieren und Excel bekommen, um die Kopierarbeit für mich zu machen.

Vielen Dank für jede Hilfe

Answer 1

Dies scheint Im arbeiten, aber erraten es eine schönere Art und Weise ist !!

Private Sub MoveThem() 
Dim sws As Worksheet 
Dim tws As Worksheet 
Dim cel As Range 
Set sws = Sheets("ALLSelections") 
Dim selectionTop, selectionBottom As Integer 
Dim sNm As String 
Dim lCol As Long 
Dim currentRow As Long 

selectionTop = 0 
selectionBottom = 0 

'~~> Get the last row and last column 
lRow = sws.Range("C" & sws.Rows.Count).End(xlUp).Row 
lCol = sws.Cells(1, sws.Columns.Count).End(xlToLeft).Column 

For currentRow = 2 To lRow 
    If sws.Cells(currentRow, 1) > 1 Then 

     If selectionTop = 0 Then 
      selectionTop = currentRow 

      ' Get the new sheet name 
      sNm = sws.Cells(currentRow, 2).Value 
      If Not WksExists(sNm) Then 
       ' If not already created then add to Misc 
       sNm = "Misc" 
      End If 
      Set tws = Sheets(sNm) 
     End If 
    End If 

    ' Check out the next row 
    If Len(sws.Cells(currentRow, 1).Offset(1)) <> 0 Then 
     If selectionTop <> 0 And selectionBottom = 0 Then selectionBottom = currentRow 
    End If 

    If currentRow = lRow Then selectionBottom = currentRow 

    If selectionTop <> 0 And selectionBottom <> 0 Then 
     ' We know know the range of rows 
     sws.Range("A" & selectionTop, "I" & selectionBottom).Copy tws.Range("A" & tws.Range("C" & Rows.Count).End(xlUp).Offset(1).Row) 
     selectionTop = 0 
     selectionBottom = 0 
    Else 

    End If 

Next 
MsgBox ("Complete") 
End Sub