Clever-Excel-Forum

Hallo liebe Forumsmitglieder,

Ich bin Ole und noch relativ neu mit Excel und VBA, aber muss momentan ein kleines Projekt fertigstellen und bin ein klein wenig verzweifelt. Hoffentlich könnt Ihr mir helfen :)

Ich bin gerade dabei ein Formular zu erstellen, in welchem man Daten für einen Test anlegt. Bestimmte Daten sollen per Knopfdruck zum einen in das Tabellenblatt "Testprotokoll" & zum anderen und das ist mein Problem, sollen die gesamten Daten, je nachdem welcher Wert in der Zelle Thema bzw. C7 steht, in das Tabellenblatt mit dem gleichen Namen kopiert werden.

[img]
Dateiupload bitte im Forum! So geht es: Klick mich!
]

Mein Code sieht bisher so aus:

Code:
Sub Daten_zu_Protokoll()

Dim Test_ID As String

Dim Testbezeichnung As String

Dim Thema As String

Dim Release As String

Dim Sprint As String

Dim Vorbedingung As String

Dim Testschritte As String

Dim Ergebnis As String

Dim Nachbedingung As String

Worksheets("Eingabe").Select

Test_ID = Range("C3")

Testbezeichnung = Range("C5")

Thema = Range("C7")

Release = Range("C9")

Sprint = Range("C11")

Vorbedingung = Range("C13")

Testschritte = Range("C15")

Ergebnis = Range("C17")

Nachbedingung = Range("C19")

Worksheets("Testprotokoll").Select

Worksheets("Testprotokoll").Range("A1").Select

If Worksheets("Testprotokoll").Range("A1").Offset(1, 0) <> "" Then

Worksheets("Testprotokoll").Range("A1").End(xlDown).Select

End If

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = Test_ID

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Testbezeichnung

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Thema

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Release

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Sprint

Worksheets("Flotte").Select

Worksheets("Flotte").Range("B8").Select

If Worksheets("Flotte").Range("B8").Offset(1, 0) <> "" Then

Worksheets("Flotte").Range("B8").End(xlDown).Select

End If

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = Test_ID

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Testbezeichnung

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Thema

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Release

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Sprint

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Vorbedingung

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Testschritte

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Ergebnis

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Nachbedingung

End Sub

Private Sub CommandButton1_Click()

End Sub

Ich weiß so zirka wie If-Statements funktionieren, aber ich weiß nicht wie ich die "doppelte Verschachtelung" hinkriege.. Ich meine, dass ja zum einen anhand des Werts in der Zelle Thema entschieden werden muss, in welches Tabellenblatt die Daten kopiert werden müssen & dann muss die If-Funktion mit, welche sagt, dass wenn die Zeile im Zieltabellenblatt schon beschrieben ist, eine Zeile weiter unten genutzt werden muss.

Ich hoffe Ihr versteht mein Problem und könnt mir irgendwie weiterhelfen! Anhand findet Ihr noch ein Bild von dem Formular.

Bleibt gesund & beste Grüße
Ole

Hallo,

wenn du dich ernsthaft mit VBA beschäftigen möchtest, solltest du nicht mit dem Makro-Editor arbeiten. Der erzeugt sehr viel Müll, zum Beispiel Select-Anweisungen, die zu weit über 95% überflüssig sind. Mehrere Arbeitsblätter mit gleichartigen Inhalten sollte man ebenfalls nicht verwenden.

Dankeschön für den Hinweis!

Ich werde mir das mal anschauen. Können Sie mir eventuell mit meinem Problem weiterhelfen?

Hallo,

Zitat:solltest du nicht mit dem Makro-Editor arbeiten.

ich meinte natürlich den Makro-Rekorder.

Hallo,

vielleicht so in der Art.

Code:
With Worksheets("Eingabe")

   Test_ID = .Range("C3")

   Testbezeichnung = .Range("C5")

   Thema = .Range("C7")

   Release = .Range("C9")

   Sprint = .Range("C11")

   Vorbedingung = .Range("C13")

   Testschritte = .Range("C15")

   Ergebnis = .Range("C17")

   Nachbedingung = .Range("C19")

End With

'

With Worksheets(Thema)

   .Range("A1").Value = Test_ID

End With

Hallo Stefan,

Vielen Dank für deine Hilfe. Ich habe in der Zwischenzeit eine Lösung gefunden um anhand des Themas die Daten auf das jeweilige Tabellenblatt zu übertragen. Mein Problem ist jetzt nurnoch, dass ich das Programm dazu bringen muss die Daten untereinander zu schreiben, sollten die Zeilen schon belegt sein.

Ich schicke nochmal kurz den Code damit du siehst was ich geändert habe.

Code:
Sub Daten_zu_Protokoll()

Dim Test_ID As String

Dim Testbezeichnung As String

Dim Thema As String

Dim Release As String

Dim Sprint As String

Dim Vorbedingung As String

Dim Testschritte As String

Dim Ergebnis As String

Dim Nachbedingung As String

Worksheets("Eingabe").Select

Test_ID = Range("C3")

Testbezeichnung = Range("C5")

Thema = Range("C7")

Release = Range("C9")

Sprint = Range("C11")

Vorbedingung = Range("C13")

Testschritte = Range("C15")

Ergebnis = Range("C17")

Nachbedingung = Range("C19")

Worksheets("Testprotokoll").Select

Worksheets("Testprotokoll").Range("A1").Select

If Worksheets("Testprotokoll").Range("A1").Offset(1, 0) <> "" Then

Worksheets("Testprotokoll").Range("A1").End(xlDown).Select

End If

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = Test_ID

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Testbezeichnung

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Thema

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Release

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Sprint

If Cells(7, 3).Value = "Flotte" Then

    Worksheets("Flotte").Select

    Worksheets("Flotte").Range("B8").Select

End If

If Cells(7, 3).Value = "Mitarbeiter" Then

    Worksheets("Mitarbeiter").Select

    Worksheets("Mitarbeiter").Range("B8").Select

End If

If Cells(7, 3).Value = "Accountverwaltung" Then

    Worksheets("Accountverwaltung").Select

    Worksheets("Accountverwaltung").Range("B8").Select

End If

If Cells(7, 3).Value = "Loginprozess" Then

    Worksheets("Loginprozess").Select

    Worksheets("Loginprozess").Range("B8").Select

End If

If Cells(7, 3).Value = "Registrierungsprozess" Then

    Worksheets("Registrierungsprozess").Select

    Worksheets("Registrierungsprozess").Range("B8").Select

End If

If Cells(7, 3).Value = "Unternehmensverwaltung" Then

    Worksheets("Unternehmensverwaltung").Select

    Worksheets("Unternehmensverwaltung").Range("B8").Select

End If

If Cells(7, 3).Value = "Kontrollen" Then

    Worksheets("Kontrollen").Select

    Worksheets("Kontrollen").Range("B8").Select

End If

If Cells(7, 3).Value = "Berichte" Then

    Worksheets("Berichte").Select

    Worksheets("Berichte").Range("B8").Select

End If

If Cells(7, 3).Value = "Notfall" Then

    Worksheets("Notfall").Select

    Worksheets("Notfall").Range("B8").Select

End If

If Cells(7, 3).Value = "Rechnung" Then

    Worksheets("Rechnung").Select

    Worksheets("Rechnung").Range("B8").Select

End If

If Cells(7, 3).Value = "Vorfinanzierung" Then

    Worksheets("Vorfinanzierung").Select

    Worksheets("Vorfinanzierung").Range("B8").Select

End If

If Cells(7, 3).Value = "Timocom" Then

    Worksheets("Timocom").Select

    Worksheets("Timocom").Range("B8").Select

End If

If Cells(7, 3).Value = "Tanken & Waschen" Then

    Worksheets("Tanken & Waschen").Select

    Worksheets("Tanken & Waschen").Range("B8").Select

End If

If Cells(7, 3).Value = "SSO Wedolo Familie" Then

    Worksheets("SSO Wedolo Familie").Select

    Worksheets("SSO Wedolo Familie").Range("B8").Select

End If

If Cells(7, 3).Value = "Magazin & Logxikon" Then

    Worksheets("Magazin & Logxikon").Select

    Worksheets("Magazin & Logxikon").Range("B8").Select

End If

If Cells(7, 3).Value = "Admin Funktionen" Then

    Worksheets("Admin Funktionen").Select

    Worksheets("Admin Funktionen").Range("B8").Select

End If

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = Test_ID

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Testbezeichnung

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Thema

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Release

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Sprint

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Vorbedingung

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Testschritte

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Ergebnis

ActiveCell.Offset(0, 1).Select

ActiveCell.Value = Nachbedingung

End Sub

Private Sub CommandButton1_Click()

End Sub

Ich gebe zu die If Lösung ist nicht sehr elegant, aber sie tut was sie soll. Hast du oder irgendjemand anderes eine Idee wie ich die Anweisung mit dem untereinander schreiben noch einbinden kann?

Mit besten Grüßen
Ole

Hallo,

hier eine optimierte Lösung für dein If-Problem. Um die (überflüssigen) Selectanweisungen habe ich mich jetzt nicht gekümmert, da du ja auch an dieser Stelle beratungsresistent zu sein scheinst.

Code:
Select Case Cells(7, 3).Value

        Case Is = "Flotte"

            Worksheets("Flotte").Select

            Worksheets("Flotte").Range("B8").Select

        Case Is = "Mitarbeiter"

            Worksheets("Mitarbeiter").Select

            Worksheets("Mitarbeiter").Range("B8").Select

        Case Is = "Accountverwaltung"

            Worksheets("Accountverwaltung").Select

            Worksheets("Accountverwaltung").Range("B8").Select

        Case Is = "Loginprozess"

            Worksheets("Loginprozess").Select

            Worksheets("Loginprozess").Range("B8").Select

        Case Is = "Registrierungsprozess"

            Worksheets("Registrierungsprozess").Select

            Worksheets("Registrierungsprozess").Range("B8").Select

        Case Is = "Unternehmensverwaltung"

            Worksheets("Unternehmensverwaltung").Select

            Worksheets("Unternehmensverwaltung").Range("B8").Select

        Case Is = "Kontrollen"

            Worksheets("Kontrollen").Select

            Worksheets("Kontrollen").Range("B8").Select

        Case Is = "Berichte"

            Worksheets("Berichte").Select

            Worksheets("Berichte").Range("B8").Select

        Case Is = "Notfall"

            Worksheets("Notfall").Select

            Worksheets("Notfall").Range("B8").Select

        Case Is = "Rechnung"

            Worksheets("Rechnung").Select

            Worksheets("Rechnung").Range("B8").Select

        Case Is = "Vorfinanzierung"

            Worksheets("Vorfinanzierung").Select

            Worksheets("Vorfinanzierung").Range("B8").Select

        Case Is = "Timocom"

            Worksheets("Timocom").Select

            Worksheets("Timocom").Range("B8").Select

        Case Is = "Tanken & Waschen"

            Worksheets("Tanken & Waschen").Select

            Worksheets("Tanken & Waschen").Range("B8").Select

        Case Is = "SSO Wedolo Familie"

            Worksheets("SSO Wedolo Familie").Select

            Worksheets("SSO Wedolo Familie").Range("B8").Select

        Case Is = "Magazin & Logxikon"

            Worksheets("Magazin & Logxikon").Select

            Worksheets("Magazin & Logxikon").Range("B8").Select

        Case Is = "Admin Funktionen"

            Worksheets("Admin Funktionen").Select

            Worksheets("Admin Funktionen").Range("B8").Select

    End Select

Allerdings gehe ich davon aus, dass man das noch weiter optimieren könnte, dazu müsste man aber deine Datei kennen. Ich hatte jetzt keine Lust zu suchen, wie die Blattnamen in die Zelle C7 kommen. Da könnte man möglicherweise direkt drauf reagieren.

Hallo,

vielleicht so?

Code:
Sub Daten_zu_Protokoll()

   Dim Test_ID As String

   Dim Testbezeichnung As String

   Dim Thema As String

   Dim Release As String

   Dim Sprint As String

   Dim Vorbedingung As String

   Dim Testschritte As String

   Dim Ergebnis As String

   Dim Nachbedingung As String

   Dim lngC As Long

   With Worksheets("Eingabe")

      Test_ID = .Range("C3")

      Testbezeichnung = .Range("C5")

      Thema = .Range("C7")

      Release = .Range("C9")

      Sprint = .Range("C11")

      Vorbedingung = .Range("C13")

      Testschritte = .Range("C15")

      Ergebnis = .Range("C17")

      Nachbedingung = .Range("C19")

   End With

   With Worksheets("Testprotokoll")

      lngC = .Cells(.Rows.Count, 1).End(xlUp).Row + 1

      .Cells(lngC, 0).Value = Test_ID

      .Cells(lngC + 1, 1).Value = Testbezeichnung

      .Cells(lngC + 2, 1).Value = Thema

      .Cells(lngC + 3, 1).Value = Release

      .Cells(lngC + 4, 1).Value = Sprint

   End With

   With Worksheets(Worksheets("Tagesprotokoll").Cells(7, 3).Value) '<------ hier bitte auf das richtige Tabellenblatt ab?ndern

      lngC = .Cells(.Rows.Count, 2).End(xlUp).Row + 1

      If lngC <= 8 Then lngC = 9

      .Cells(lngC, 2).Value = Test_ID

      .Cells(lngC, 3).Value = Testbezeichnung

      .Cells(lngC, 4).Value = Thema

      .Cells(lngC, 5).Value = Release

      .Cells(lngC, 6).Value = Sprint

      .Cells(lngC, 7).Value = Vorbedingung

      .Cells(lngC, 8).Value = Testschritte

      .Cells(lngC, 9).Value = Ergebnis

      .Cells(lngC, 10).Value = Nachbedingung

   End With

End Sub

Ole_Wald

Klaus-Dieter

Ole_Wald

Klaus-Dieter

Steffl

Ole_Wald

Klaus-Dieter

Steffl