Kopiere Zelle wenn Bedingungen erfüllt

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Christian
Siehe Anhang.
https://www.herber.de/bbs/user/104541.xlsm
Die Resultat Tabelle musste ich etwas anpassen (einheitliche Struktur). Verbundene Zellen machen nur Probleme und sind in diesem Fall unnötig.
Komische Punktewertung: 3,5,9 gibt es nicht...

Sub MachMal()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim iZeile As Long, tempZeile As Long
Dim strMark As String
Set WS1 = Worksheets("Fragen")
Set WS2 = Worksheets("Zusammenfassung")
Application.ScreenUpdating = False
For iZeile = WS1.Cells(WS1.Rows.Count, 3).End(xlUp).Row To 5 Step -1
If IsNumeric(WS1.Cells(iZeile, 3)) And WS1.Cells(iZeile, 3)  "" Then
Select Case WS1.Cells(iZeile, 3)
Case 10: strMark = "Positive Bemerkungen (10 Punkte):"
Case 6 To 8: strMark = "Hinweise / Verbesserungsvorschläge (6-8 Punkte):"
Case 4: strMark = "Nebenabweichungen (4 Punkte):"
Case 0 To 2: strMark = "Hauptabweichungen (0 - 2 Punkte):"
Case Else: strMark = ""
End Select
If strMark  "" Then
tempZeile = Application.Match(strMark, WS2.Columns(2), 0) + 1
WS2.Rows(tempZeile).Insert Shift:=xlDown
WS2.Cells(tempZeile, 1) = WS1.Cells(iZeile, 1)
WS2.Cells(tempZeile, 2) = WS1.Cells(iZeile, 4)
Call ZeileFormatieren(tempZeile, WS2)
End If
End If
Next iZeile
End Sub

Private Sub ZeileFormatieren(Zeile As Long, WS As Worksheet)
With WS.Range(WS.Cells(Zeile, 1), WS.Cells(Zeile, 2))
.Interior.Pattern = xlNone
.Font.Bold = False
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
End Sub

cu
Chris

Hi Christian
Da du geschrieben hast, dass die Bemerkungen überschrieben werden, ging ich davon aus, dass es eine einamlige Sache ist (zusammenkopieren ohne löschen).
Man könnte erweitern, dass sich die Tabelle komplett neu aufbaut (löschen und kopieren) d.h. angepasste Bemerkungen gehen verloren.
Oder man könnte mit etwas mehr Aufwand nur kopieren, was nicht manuell geändert wurde. Fraglich ob sich der Aufwand lohnt, weil sich der Sinn nicht erschliesst. Grundsätzlich bin ich für eine Trennung von Daten und Auswertung d.h. allfällige Bemerkungen im Blatt Fragen dokumentieren (falls der Ursprungszustand erhalten bleiben muss halt in der Spalte daneben).
Zum automatischen Starten von Codes gibt diverse Events/Ereignisse z.B. bei Aktivierung der Tabelle. Auch bei Change/Änderung einer Zelle, aber dann läuft der Code x-fach ab (bei jeder Zellenänderung).
Und die Prozedur ZeileFormatieren wird aus dem anderen Makro heraus aufgerufen. Direkt starten kannst du es nicht, weil die zu formatierende Zeilennummer und das zuvor definierte Arbeitblatt als Variable mit übergeben wird.
ciux
Chris

Beliebteste Forumthreads (12 Monate)

Kopiere Zelle wenn Bedingungen erfüllt

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

370 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kopiere Zelle wenn Bedingungen erfüllt

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

370 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread