Kopieren Bereich nicht finden

Question

Ich habe einen Kalender (siehe Bild) in Excel zusammengestellt und eine der Funktionen, die ich versuche zu erarbeiten ist, wie die Aufgaben an diesem Tag zu extrahieren und diese Aufgaben auf ein anderes Arbeitsblatt kopieren.

Ich habe den Code an folgende

Sub OtherTask() 
Dim DRng As Range 

ActiveSheet.Range("g2:ah2").Find(Date).Select 
ActiveCell.Resize(5).Offset(4).Select 
Selection.AutoFilter Field:=1, Criteria1:="1", Operator:=xlFilterValues 

'Selection.Copy 
'ActiveSheet.Range("r12").PasteSpecial xlPasteValues 

'Application.CutCopyMode = False 

    If ActiveSheet.AutoFilterMode = "True" Then 
     ActiveSheet.AutoFilterMode = "False" 
    End If 

End Sub

aktualisiert I DRNG als Range erklärt haben, aber ich kann nicht herausfinden, wie man es so eingestellt, dass DRNG darstellt die folgenden

ActiveSheet.Range("g2:ah2").Find(Date).Select 
ActiveCell.Resize(5).Offset(4).Select 
Selection.AutoFilter Field:=1, Criteria1:="1", Operator:=xlFilterValues 

Das Endziel ist zu haben die Excel-Tabelle erkennen das Datum des an diesem Tag - durchgeführt mit dem folgenden

ActiveSheet.Range("g2:ah2").Find(Date).Select 

Sobald das Datum Blick durch die Säule aufgebaut und filtern alle Zellen, die die # „1“ in der Zelle haben - erreicht mit der folgenden

Sobald dies geschehen ist, würde ich im Idealfall Excel zu dann wieder zurück in Richtung Spalte B gehen (Ich habe versucht, wird dies eingestellt und eine negative Zahl - kein Glück) und kopieren Sie dann, was in Spalte B entspricht Zeile, in der eine "1" vorhanden ist. Wenn ich mir das Bild anschaue, wäre ein Beispiel am 19. Februar. Ich würde mich übertreffen wollen, um die Aktivität 1A (die in Zelle B7 ist) zu finden und diese Zelle zu kopieren.

Mein Gedanke war, dass ich, sobald ich in der Lage war, den Tag und die Zellen mit einer "1" in ihnen zu finden, dies als Range DRng setzen und dann DRng zu Spalte B verschieben und die geeignete Zellen. Vielleicht (mehr als wahrscheinlich) denke ich darüber falsch, da das Ziel mit dem, was ich hier habe, nicht erreicht werden kann. Ich habe mit einer if Aussage zwischen With/End With gespielt, aber kein Glück. Jede Idee/Richtung wird sehr geschätzt. Danke

Answer 1

Hmm Ich bin nicht sicher, ob ich deine Frage richtig interpretiere, weil es ein wenig vage ist. Möchten Sie die Spalte nach unten gehen und die entsprechende Aktivität aufnehmen und in ein neues Blatt einfügen? Wenn ja, versuchen Sie dies

Sub TodaysDate() 
Dim DRng As Range 
Dim TASKng As Range 
Dim newSh As Worksheet 

'set the column to loop 
col = Range("g2:ah2").Find(Date).column 

'create new worksheet 
Set newSH = thisworkbook.worksheets.add 
tarRow = 1 'set which row to start writing data 

For i = 6 to 36  'set which rows to loop 
    If activesheet.cells(i,col).value = 1 then 
      newSH.cells(tarRow,1) = activesheet.cells(i,1) 
      tarRow = tarRow +1 
    End if 
Next i