Werte exportien aus verschiedenen zellen

Sub KopiereWerteNachGesamtProvisionBisZeile631()



    ' Variablen deklarieren

    Dim wbZiel As Workbook

    Dim wsZiel As Worksheet

    Dim tbl As ListObject

    Dim neueZeile As ListRow

    Dim quellWert As Variant

    Dim i As Integer, j As Integer

    Dim quellStartRow As Integer, quellEndRow As Integer

    Dim spaltenIndex As Integer

    

    ' Start- und Endzeilen festlegen

    quellStartRow = 4

    quellEndRow = 631

    

    ' Zielarbeitsmappe und -arbeitsblatt öffnen

    Set wbZiel = Workbooks.Open("F:\MFM16092024\Test\GesamtProvision.xlsm")

    Set wsZiel = wbZiel.Sheets("Provisionen")

    Set tbl = wsZiel.ListObjects("tblGesamtProvision")

    

    ' Array mit Zellspalten und Zielspalten erstellen

    Dim zellenUndSpalten As Variant

    zellenUndSpalten = Array( _

        Array("D", "Kunde"), _

        Array("D", "Auftragsnummer"), _

        Array("D", "Auftragseingang"), _

        Array("D", "Zahlungseingang"), _

        Array("D", "Abzug AK"), _

        Array("D", "Gesamt Umsatz"), _

        Array("D", "Gesamt Umsatz (Gv)"), _

        Array("D", "Gesamt Verbaukosten"), _

        Array("D", "Gesamt AB"), _

        Array("D", "ÜberUnterPrv"), _

        Array("D", "AB %"), _

        Array("D", "VB %"), _

        Array("H", "Beteiligung"), _

        Array("H", "Verkäufer"), _

        Array("J", "ProvMittel"), _

        Array("L", "Prov"), _

        Array("M", "Ü/U"), _

        Array("N", "Provision"), _

        Array("O", "Provision Kulanz"), _

        Array("P", "ProvGesamt"), _

        Array("Q", "Provision Soll") _

    )

    

    ' Schleife über alle Zeilen von quellStartRow bis quellEndRow

    For j = quellStartRow To quellEndRow

        

        ' Nur Zeilen kopieren, die Daten enthalten

        If WorksheetFunction.CountA(ThisWorkbook.ActiveSheet.Rows(j)) > 0 Then

            

            ' Neue Zeile in der Tabelle hinzufügen

            Set neueZeile = tbl.ListRows.Add

            

            ' Werte aus den angegebenen Zellen in die Tabelle kopieren

            For i = LBound(zellenUndSpalten) To UBound(zellenUndSpalten)

                

                ' Einzelnen Zellwert aus dem aktiven Arbeitsblatt lesen

                quellWert = ThisWorkbook.ActiveSheet.Range(zellenUndSpalten(i)(0) & j).Value

                

                ' Prüfen, ob der Zellwert nicht leer ist

                If Not IsEmpty(quellWert) Then

                    

                    ' Überprüfen, ob die Spalte existiert, bevor versucht wird, darauf zuzugreifen

                    On Error Resume Next

                    spaltenIndex = tbl.ListColumns(zellenUndSpalten(i)(1)).Index

                    On Error GoTo 0

                    

                    If spaltenIndex > 0 Then

                        ' Wert in die entsprechende Spalte der neuen Zeile der Tabelle kopieren

                        neueZeile.Range(spaltenIndex).Value = quellWert

                    Else

                        ' Fehlermeldung anzeigen, falls Spalte nicht existiert

                        MsgBox "Die Spalte '" & zellenUndSpalten(i)(1) & "' wurde in tblGesamtProvision nicht gefunden.", vbExclamation

                    End If

                End If



            Next i

            

        End If

        

    Next j

    

    ' Arbeitsmappe speichern und schließen

    wbZiel.Save

    wbZiel.Close

    

    ' Fertigmeldung

    MsgBox "Werte von Zeile 4 bis 631 wurden erfolgreich kopiert!", vbInformation



End Sub