VBA Daten in ein anderes Tabellenblatt k
16.07.2020 09:44:13
Laura
ich bin gerade dabei ein Excel-Planungstool für unser Team zu entwerfen. Die Idee ist, dass man aus einer Liste die Projekte ankreuzen kann (dazu hat jeder Mitarbeiter seine/ihre eigene Spalte mit eigenem Kürzel), an denen man arbeiten, dann sein Kürzel in ein Feld eingibt und dann auf ein Button "Übertragen" drückt. Dabei werden die Projektinformationen (Spalten A-F; dort wo man ein Kreuz gesetzt hat) in sein eigenes Arbeitsblatt (wieder mit eigenem Kürzel) übertragen. Ich habe dazu einen Button entwickelt, der dann mit "Select Case" jeweils das Kürzel auswählt, das eingegeben wurde und die Informationen, die in der jeweiligen Spalte zu dem zugehörigen Kürzel angekreuzt wurden, in das jeweilige Arbeitsblatt überträgt. Mein einziges Problem ist derzeit, dass die Projektinformationen immer wieder in das jeweilige Arbeitsblatt übergetragen werden, sobald man auf den Button drückt, d.h. zurzeit prüft das Programm nicht, ob dieses Projekt schon in dem jeweiligen Arbeitsblatt steht. Ich habe mir schon lange den Kopf zerbrochen, aber bisher hat noch nichts funktioniert... Ich hatte überlegt, dass man einen Array konzipiert, der dann die "Kreuze" erstmal speichert und dann in dem jeweiligen Arbeitsblatt abgleicht, ob diese schon vorhanden sind, und dann nur die neuen Projekte einträgt. Hat jemand eine Idee, wie man das eleganter lösen könnte?
Hier ist der bisherige VBA-Code (Anmerkung: 'THB' ist dabei das Kürzel eines Mitarbeiters):
Sub Button59_Click()
Dim Wert As String
Dim Spaltennr As Long
Dim Zeile, Ziel_Zeile As Integer
Dim ThisValue As String
Dim Anzahl_Projekte As Integer
Wert = Worksheets("Planung 2020-21").Cells(2, 34).Value
Select Case Wert
Case "THB"
Sheets("Planung 2020-21").Activate
FinalRow = Cells(Rows.Count, 6).End(xlUp).Row
Spaltennr = Columns("AG").Column
Ziel_Zeile = Worksheets("THB").Cells(Rows.Count, 1).End(xlUp).Row
For i = 6 To FinalRow
ThisValue = Cells(i, Spaltennr).Value
If ThisValue = "x" Or ThisValue = "X" Then
With Worksheets("Planung 2020-21")
.Range("A" & i & ":" & "F" & i).Copy Destination:=Worksheets("THB").Range(" _
_
_
A" & Ziel_Zeile & ":" & "F" & Ziel_Zeile)
End With
Anzahl_Projekte = Anzahl_Projekte + 1
Ziel_Zeile = Ziel_Zeile + 1
End If
Next i
MsgBox Anzahl_Projekte & " Projekte wurden erfolgreich in das Arbeitsblatt THB kopiert." _
_
_
'(hier kommen dann noch weitere Cases von den anderen Kollegen)
Case Else
MsgBox "Das eingegebene Kürzel exisiert in diesem Arbeitsblatt nicht."
End Select
End Sub
Vielen Dank schon mal!