VBA Code Wert in anderem Blatt setzen

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim lngRow As Long If Not Intersect(Target, Range("P4:P250")) Is Nothing Then Cancel = True Target = Now Select Case Target.Column Case 16 Cells(Target.Row, 1) = 8 'Dieser Wert soll dann auch ins Blatt "Projekte" _ geschrieben werden 'Hier soll er den Wert aus Zelle F der gewählten Reihe im Blatt "Projekte" suchen _ _ und dort auch den Wert in Zelle A schreiben If MsgBox("Ist dieser Arbeitsschritt für dieses Projekt wirklich fertig?", _ vbQuestion Or vbOKCancel, "Abfrage") = vbOK Then Target.EntireRow.Delete End If Case Else End Select End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Dim Rafound As Range Dim Target1 As String With Worksheets("Projekte") Set Rafound = .Columns(6).find(Target, .Range("F" & Rows.Count), xlFormulas, _ xlWhole, , xlNext) If Not Rafound Is Nothing Then Rafound.Offset(0, -5) = Target1 End If Set Rafound = Nothing End With

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim lngRow As Long If Not Intersect(Target, Range("P4:P250")) Is Nothing Then Cancel = True Target = Now Select Case Target.Column Case 16 Cells(Target.Row, 1) = 8 Dim Rafound As Range Dim Target1 As String With Worksheets("Projekte") Set Rafound = .Columns(6).Find(Target, .Range("F" & Rows.Count), xlFormulas, _ xlWhole, , xlNext) If Not Rafound Is Nothing Then Rafound.Offset(0, -5) = Target1 End If Set Rafound = Nothing End With If MsgBox("Ist dieser Arbeitsschritt für dieses Projekt wirklich fertig?", _ vbQuestion Or vbOKCancel, "Abfrage") = vbOK Then Target.EntireRow.Delete End If Case Else End Select End If End Sub

Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim lngRow As Long Dim objCell As Range If Not Intersect(Target, Range("P4:P250")) Is Nothing Then Cancel = True Target = Now Cells(Target.Row, 1).Value = 8 Set objCell = Worksheets("Projekte").Columns(6).Find(What:=Cells(Target.Row, 6).Value, _ _ LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) If Not objCell Is Nothing Then objCell.Offset(0, -5).Value = 8 Set objCell = Nothing Else MsgBox "Nix gefunden" End If If MsgBox("Ist dieser Arbeitsschritt für dieses Projekt wirklich fertig?", _ vbQuestion Or vbOKCancel, "Abfrage") = vbOK Then Target.EntireRow.Delete End If End If End Sub

Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim raFund As Range If Not Intersect(Target, Range("P4:P250")) Is Nothing Then Cancel = True Target = Now Target.Offset(, -15) = 8 Set raFund = Worksheets("Projekte").Columns("F").Find(what:=Target.Offset(, -10), _ LookIn:=xlValues, lookat:=xlWhole) If Not raFund Is Nothing Then raFund.Offset(, -5) = 8 If MsgBox("Ist dieser Arbeitsschritt für dieses Projekt wirklich fertig?", _ vbQuestion Or vbOKCancel, "Abfrage") = vbOK Then Target.EntireRow.Delete End If Else MsgBox "Fehler: Das Projekt " & Target.Offset(, -10) & " ist in Projekte nicht _ vorhanden." End If End If Set raFund = Nothing End Sub

Hallo Werner,
Hallo Nepumuk,
Hätte da noch ein gravierendes Problem in meiner Excel.
Mit folgendem Code kopiere ich diverse Zeilen durch die einzelnen Blätter.
Mein Problem ist sobald ich in den Blättern ein Filter gesetzt habe( was unbedingt von Nöten wäre) findet er beim suchen der nächsten freien Zeile diese nicht und bricht den Kopiervorgang ab. Habt ihr zwei Experten dazu eine Idee?
Bin mir sicher das ihr dazu auch eine Lösung habt, das wäre supi.......
Hier der Code

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lngRow As Long
If Not Intersect(Target, Range("AG4:AK250")) Is Nothing Then
Cancel = True
Target = Date
Select Case Target.Column
Case 33
Cells(Target.Row, 1) = 2
Case 34
Cells(Target.Row, 1) = 3
Case 35
Cells(Target.Row, 1) = 4
Case 37
If MsgBox("Willst du wirklich dieses Projekt an den Einkauf übergeben?", _
vbQuestion Or vbOKCancel, "Abfrage") = vbOK Then
Cells(Target.Row, 1) = 5
With Worksheets("IV")
lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Target.EntireRow.Copy .Rows(lngRow)
Target.EntireRow.Delete
End With
End If
Case Else
End Select
End If
End Sub

Hallo Nepumuk,
Ich kopiere ja nicht die ganze Zeile sondern nur immer die Zellen A-AO mit folgenden Code.
Target.Offset(, -35).Resize(, 41).Copy .Rows(lngRow)
Grunde dafür ist ein Gantt Diagramm ab Spalte AP der mit Desinteresse Formatierung die Produktionszeiten darstellt.
Diese Formatierungen will ich beim kopieren nicht mit nehmen. Deswegen nur die Kopie der einzelnen Zellen.
Vielleicht gibt es eine Bessere Lösung für den kopier Befehl. fakt ist ich hatte heute gefiltert und gruppiert.
Und er hat dann gefragt ob er die ganze Zeile löschen soll und hat nur die sichtbaren Zellen kopiert. Auch war anschliessend alles mega langsam. Irgendwas hat ihm nicht gefallen. Wie schon gesagt ist es sehr schwierig dir jetzt hier alle Einzelheiten zu schreiben. Ich war heute auch erst mal mega genervt und habe erst mal nicht weiter nach dem Fehler gesucht.
Mal schauen was ich morgen noch raus bekomme. aber vielleicht hast du ja schon ne Idee für eine andere Anweisung zum kopieren.

Beliebteste Forumthreads (12 Monate)

VBA Code Wert in anderem Blatt setzen

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Code Wert in anderem Blatt setzen

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread