Office: (Office 2007) Excel Formular in Excel Tabelle übertragen

Hallo,

ich habe ein Formular in Excel erstellt und möchte,
dass die eingegeben Daten automatisch in eine bereits vorhandene Tabelle übertragen werden.
Es handelt sich hierbei um zwei unterschiedliche Mappen.

Hoffe ihr versteht, was ich meine.

LG

 

Hi,

ganz einfach: ermittle die Zeile, in die die Daten übertragen werden sollen und benutze dann die Inhalte der betreffenden Steuerelemente, um sie in die betreffende Zeile in der relevanten Spalte einzutragen.

Bis später,
Karin

 

Danke für deine Antwort,

jedoch kann ich damit leider nichts anfangen :S

 

Hola,

dann beschreib doch mal bitte genau, wie dein Formular aussieht - am Besten anhand einer Beispieltabelle.

Gruß,
steve1da

 

Hi,

genau so wenig können wir mit deiner Beschreibung etwas anfangen. Lade also eine Beispielmappe hoch, dann kann man die Antwort ganz konkret auf deine Dedingungen anpassen.

Bis später,
Karin

 

Entschuldigung

Also dieses Formular möchte ich ausfüllen und die Eingabe soll nach Möglichkeit, automatisch oder nach einer bestimmten Aktion in eine bereits vorhandene Tabelle übertragen werden.

 

Und wo soll was genau hin? Also welche Zelle soll in welche übertragen werden? Sollen neue Daten dann fortlaufend in die andere Mappe/andere Tabelle übertragen werden oder? Wie heißt die andere Mappe und das Ziel-Tabellenblatt?

Bis später,
Karin

 

Die Zielmappe heißt "Probeliste", das Datenblatt ebenso und die Daten aus dem Formular sollen sich automatisch, sobald das Formular ausgefüllt wird, in die nächste freie Zeile übertragen.
Übertragen werden sollen:

C4-->X1
F4(Auswahlfenster)-->x2
B7-->X4
G7-->X5
K7-->X3
B10-->X7
G10-->X8
K10-->X6
B15-->X9
K15-->X10
B18/B21/G18/G21(Auswahlfenster)-->X11-X14
K18(Auswahlfenster)-->X22
K21-->X24
H25-->X23
D25-->X15
D27-->X16
D29-->X17
D31-->X18
D33-->X19
D35-->X20
D37-->X21
B41-->X25

 

Ich hoffe, ich habe die richten Zuordnungen übernommen - da deine aufgeführte Reihenfolge nicht der Spaltenreihenfolge entspricht, könnte es sein, dass ich irgendwo die falsche genommen habe. Das musst du im Code dann korrigieren.

Bis später,
Karin

 

Ich bedanke mich ganz Herzlich bei dir.
Ich werde es gleich mal ausprobieren :)

 

Also es funktioniert wunderbar, jetzt hätte ich doch nochmal zwei Fragen :S

Ich hätte das Formular doch gerne in der Zielmappe mit drinnen, was muss ich da abändern? Und wäre es möglich, dass sich das Formular nachdem man auf Übertragen geklickt hat, von selbst leert?

Code:

Option Explicit

Sub Uebertragen()
    Dim lngErste As Long
    Dim lngZeile As Long
    Dim strBereich As String
    With Workbooks("Test.xls").Worksheets("Probe u. Anfrage")
        lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
        .Cells(lngErste, 1) = Range("C4")
        strBereich = ActiveSheet.Shapes("Drop Down 27").DrawingObject.ListFillRange
        lngZeile = ActiveSheet.Shapes("Drop Down 27").DrawingObject.Value
        .Cells(lngErste, 2) = Range(strBereich).Cells(lngZeile)
        .Cells(lngErste, 3) = Range("K7")
        .Cells(lngErste, 3).NumberFormat = "dd.mm.yyyy"
        .Cells(lngErste, 4) = Range("B7")
        .Cells(lngErste, 5) = Range("G7")
        .Cells(lngErste, 6) = Range("K10")
        .Cells(lngErste, 7) = Range("B10")
        .Cells(lngErste, 8) = Range("G10")
        .Cells(lngErste, 9) = Range("B15")
        .Cells(lngErste, 10) = Range("K15")
        strBereich = ActiveSheet.Shapes("Drop Down 4").DrawingObject.ListFillRange
        lngZeile = ActiveSheet.Shapes("Drop Down 4").DrawingObject.Value
        .Cells(lngErste, 11) = Range(strBereich).Cells(lngZeile)
        strBereich = ActiveSheet.Shapes("Drop Down 6").DrawingObject.ListFillRange
        lngZeile = ActiveSheet.Shapes("Drop Down 6").DrawingObject.Value
        .Cells(lngErste, 12) = Range(strBereich).Cells(lngZeile)
        strBereich = ActiveSheet.Shapes("Drop Down 5").DrawingObject.ListFillRange
        lngZeile = ActiveSheet.Shapes("Drop Down 5").DrawingObject.Value
        .Cells(lngErste, 13) = Range(strBereich).Cells(lngZeile)
        strBereich = ActiveSheet.Shapes("Drop Down 7").DrawingObject.ListFillRange
        lngZeile = ActiveSheet.Shapes("Drop Down 7").DrawingObject.Value
        .Cells(lngErste, 14) = Range(strBereich).Cells(lngZeile)
        .Cells(lngErste, 15) = Range("D25")
        .Cells(lngErste, 15).NumberFormat = "hh:mm"
        .Cells(lngErste, 16) = Range("D27")
        .Cells(lngErste, 16).NumberFormat = "hh:mm"
        .Cells(lngErste, 17) = Range("D29")
        .Cells(lngErste, 17).NumberFormat = "hh:mm"
        .Cells(lngErste, 18) = Range("D31")
        .Cells(lngErste, 18).NumberFormat = "hh:mm"
        .Cells(lngErste, 19) = Range("D33")
        .Cells(lngErste, 19).NumberFormat = "hh:mm"
        .Cells(lngErste, 20) = Range("D35")
        .Cells(lngErste, 20).NumberFormat = "hh:mm"
        .Cells(lngErste, 21) = Range("D37")
        .Cells(lngErste, 21).NumberFormat = "hh:mm"
        strBereich = ActiveSheet.Shapes("Drop Down 21").DrawingObject.ListFillRange
        lngZeile = ActiveSheet.Shapes("Drop Down 21").DrawingObject.Value
        .Cells(lngErste, 22) = Range(strBereich).Cells(lngZeile)
        .Cells(lngErste, 23) = Range("H25")
        .Cells(lngErste, 24) = Range("K21")
        .Cells(lngErste, 25) = Range("B41")
    End With
End Sub

 

Wenn es in der Zielmappe ist, wann einfach den Bezug zum Workbook weglassen.

Code:

Sub Uebertragen()
    Dim lngErste As Long
    Dim lngZeile As Long
    Dim strBereich As String
    Dim arrZellen()
    Dim intZaehler As Integer
    arrZellen = Array(Array(1, 3, 4, 5, 6, 7, 8, 9, 10, 15, 16, 17, 18, 18, 20, 21, 23, 24, 25), _
        Array("C4", "K7", "B7", "G7", "K10", "B10", "G10", "B15", "K15", "D25", "D27", "D29", "D31", _
        "D33", "D35", "D37", "H25", "K21", "B41"))
    With Worksheets("Probeliste")
        lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
        For intZaehler = 0 To UBound(arrZellen(0)) - 1
            .Cells(lngErste, arrZellen(0)(intZaehler)) = Range(arrZellen(1)(intZaehler))
            Select Case intZaehler
                Case 1
                    .Cells(lngErste, arrZellen(0)(intZaehler)).NumberFormat = "dd.mm.yyyy"
                Case 15 To 21
                    .Cells(lngErste, arrZellen(0)(intZaehler)).NumberFormat = "hh.mm"
            End Select
            Range(arrZellen(1)(intZaehler)).MergeArea.ClearContents
        Next intZaehler
        strBereich = ActiveSheet.Shapes("Drop Down 27").DrawingObject.ListFillRange
        lngZeile = ActiveSheet.Shapes("Drop Down 27").DrawingObject.Value
        If lngZeile <> 0 Then
            .Cells(lngErste, 2) = Range(strBereich).Cells(lngZeile)
            ActiveSheet.Shapes("Drop Down 27").DrawingObject.ListIndex = 0
        End If
        strBereich = ActiveSheet.Shapes("Drop Down 4").DrawingObject.ListFillRange
        lngZeile = ActiveSheet.Shapes("Drop Down 4").DrawingObject.Value
        If lngZeile <> 0 Then
            .Cells(lngErste, 11) = Range(strBereich).Cells(lngZeile)
            ActiveSheet.Shapes("Drop Down 4").DrawingObject.ListIndex = 0
        End If
        strBereich = ActiveSheet.Shapes("Drop Down 6").DrawingObject.ListFillRange
        lngZeile = ActiveSheet.Shapes("Drop Down 6").DrawingObject.Value
        If lngZeile <> 0 Then
            .Cells(lngErste, 12) = Range(strBereich).Cells(lngZeile)
            ActiveSheet.Shapes("Drop Down 6").DrawingObject.ListIndex = 0
        End If
        strBereich = ActiveSheet.Shapes("Drop Down 5").DrawingObject.ListFillRange
        lngZeile = ActiveSheet.Shapes("Drop Down 5").DrawingObject.Value
        If lngZeile <> 0 Then
            .Cells(lngErste, 13) = Range(strBereich).Cells(lngZeile)
            ActiveSheet.Shapes("Drop Down 5").DrawingObject.ListIndex = 0
        End If
        strBereich = ActiveSheet.Shapes("Drop Down 7").DrawingObject.ListFillRange
        lngZeile = ActiveSheet.Shapes("Drop Down 7").DrawingObject.Value
        If lngZeile <> 0 Then
            .Cells(lngErste, 14) = Range(strBereich).Cells(lngZeile)
            ActiveSheet.Shapes("Drop Down 7").DrawingObject.ListIndex = 0
        End If
        strBereich = ActiveSheet.Shapes("Drop Down 21").DrawingObject.ListFillRange
        lngZeile = ActiveSheet.Shapes("Drop Down 21").DrawingObject.Value
        If lngZeile <> 0 Then
            .Cells(lngErste, 22) = Range(strBereich).Cells(lngZeile)
            ActiveSheet.Shapes("Drop Down 21").DrawingObject.ListIndex = 0
        End If
    End With
End Sub

Bis später,
Karin

 

Ich stell mich vermutlich wirklich doof an, aber zeigt mir immer eine Fehlermeldung bei

Code:

strBereich = ActiveSheet.Shapes("Drop Down 27").DrawingObject.ListFillRange

an, zwecks Laufzeitfehler und das das Element mit dem angegeben Namen nicht gefunden wurde.

 

In deiner hochgeladenen Mappe erhalte ich keinen Fehler.

Bis später,
Karin

 

Jetzt funktioniert bei mir auch alles,

also nochmal vielen Dank dir.