Zelleninhalt kopieren (Koordinaten in Schleife ermittelt)
#1
Hallo,

ich habe einen kleinen Code der mittels einer Schleife Daten in diversen Zellen mit dem aktuellen Datum vergleicht.
Ist die Differenz kleiner als ein vorgegebenen Wert wird der Zelleninhalt der Zelle aus Spalte B angezeigt (msgbox) in der sich der "Treffer" befindet.
Hierbei ist zu beachten, dass die Zellen in Spalte B teils untereinander verbunden sind.

Beispiel: Datum steht in Zelle H30, dann wird der Zelleninhalt von B29 ausgegeben, weil B29 bis B32 (...) verbunden sind.
Dies alles macht der Code problemlos (bin sehr stolz auf mich).

nun möchte ich aber, dass der Zellenwert nicht angezeigt wird, sondern in ein neues Tabellenblatt kopiert wird und zwar in die selbe Zelle, beim Beispiel wäre dies B29.

Kann mir hierzu jemand bitte helfen.:97:

Schon jetzt danke im Voraus!

Michael  

hier noch mein aktueller Code:

Code:
Sub Datendifferenz()

Range("X5") = CInt(ActiveSheet.TextBox21.Text)
tagedifferenz = Range("X5").Value
Application.EnableEvents = False
Application.EnableEvents = True


For i = 8 To 10 'Spaltenzahl
For j = 20 To 100 ' Zeilenzahl

Planname = Range("B" & Cells(j, i).Row).MergeArea(1, 1).Value

If Cells(j, i) <> "" And DateDiff("d", Cells(j, i), Date) <= tagedifferenz And DateDiff("d", Cells(j, i), Date) > (-1) Then
'wenn im Zellenbereich das Differenzdatum kleiner gleich der vorgegebenen Zahl ist UND die Datumsdifferenz nicht negativ ist, dann...


MsgBox Planname

End If

Next j
Next i

End Sub
Top
#2
Hallo,

verbundene Zellen sind Murks, verzichte darauf.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
Top
#3
Hallo Michael,
  For i = 8 To 10 'Spaltenzahl
For j = 20 To 100 ' Zeilenzahl
If Cells(j, i) <> "" And DateDiff("d", Cells(j, i), Date) <= tagedifferenz And DateDiff("d", Cells(j, i), Date) > (-1) Then
'wenn im Zellenbereich das Differenzdatum kleiner gleich der vorgegebenen Zahl ist UND die Datumsdifferenz nicht negativ ist, dann...
Worksheets("neues Tabellenblatt").Cells(j, 2).MergeArea(1, 1).Value = Cells(j, 2).MergeArea(1, 1).Value
End If
Next j
Next i
Gruß Uwe
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • Michael_1978
Top
#4
Uwe du bist der Beste!

Vielen Dank!

Ich schließe den Thread.

Gruß, Michael
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste