Microsoft Excel

Herbers Excel/VBA-Archiv

Daten in anderes Tabellenblatt kopieren

Betrifft: Daten in anderes Tabellenblatt kopieren von: Laura Kiwi
Geschrieben am: 13.08.2020 16:33:41

Hallo Zusammen,


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 (wenn es das angekreuzte Projekt schon im anderen Arbeitsblatt vorhanden ist, soll es natürlich nicht noch einmal übertragen werden). 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? - Die zugehörige Excel-Datei findet ihr hier: https://www.herber.de/bbs/user/139616.xlsm



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

Betrifft: Crosspost ohne Hinweis
von: Werner
Geschrieben am: 13.08.2020 16:42:57

Hallo,

würdest du bitte die Beiträge in den verschiedenen Foren untereinander verlinken.

Gruß Werner

Betrifft: AW: Daten in anderes Tabellenblatt kopieren
von: GerdL
Geschrieben am: 13.08.2020 22:50:43

Moin Laura!
Sheets("Planung 2020-21").Activate

Select Case Cells(2, 34).Value
 
Case "THB"
 
 
 
     Ziel_Zeile = Worksheets("THB").Cells(Rows.Count, 1).End(xlUp).Row
 
     For i = 6 To Cells(Rows.Count, 6).End(xlUp).Row
 
         If UCase(Cells(i, "AG").Value) = "X" Then

             With Worksheets("THB")
                 If WorksheetFunction.CountIfs(.Columns("A"), Cells(i, "A"), _
                                                .Columns("B"), Cells(i, "B"), _
                                                .Columns("C"), Cells(i, "C"), _
                                                .Columns("D"), Cells(i, "D"), _
                                                .Columns("E"), Cells(i, "E"), _
                                                .Columns("F"), Cells(i, "F")) = 0 Then
 
                    Range("A" & i & ":" & "F" & i).Copy _
                    Destination:=Worksheets("THB").Range("A" & Ziel_Zeile & ":" & "F" &  _
Ziel_Zeile)
                  End If
            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

Gruß Gerd