Clever-Excel-Forum

Hallo liebe Foren-Gemeinde,

ich bin noch relativ neu im Bereich VBA und Excel, versuche aber mir viel anzueigenen. Leider stehe ich aktuell total auf dem Schlauch und brauche Unterstätzung.

Was möchte ich tun:
Ich möchte aus einer Datei, deren Name sich regelmäßig ändert (Export aus anderem System mit zufällig generierter Nummer) einen Zellen Bereich kopieren und in einem bestimmen Bereich einer anderen Datei einfügen.

Was habe ich bisher getan:
Da sich der Dateiname der Datei mit den zu importierenden Datei ständig ändern, habe ich ein kleines Formular gebaut, dass mir alle offenen Excel-Datein anzeigt.

Code:
Private Sub UserForm_Initialize()

Dim wkb As Workbook

    For Each wkb In Workbooks

        lstDateinamen.AddItem wkb.Name

    Next wkb

Set wkb = Nothing

End Sub

Das funktioniert auch. Es werden mir in einer Box alle offnen Dateien angezeigt. Dort möchte ich nun die entsprechende (geöffnete) Datei anklicken und dann aus dem Tabellenblatt (es gibt immer nur eins) den Bereich B5:DZ24 kopieren und in der Ursprungsdatei (hier läuft das Makro) in das Tabellenblatt Daten einfügen. Vorhandene Werte sollen einfach überschrieben werden und die Werte aus der Importdatei sollen immer bei A1 eingefügt werden.

Zum vielleicht einfacheren Verständnis, was gemacht werden soll (+ die Dateiauswahl über das Formular), hier mal die Makroaufzeichnung.

Code:
Sub Test()

    Windows("Auswertung_210318_180842.xlsx").Activate

    Range("B5:DZ24").Select

    Selection.Copy

    Windows("Daily Report.xlsm").Activate

    Sheets("Daten").Select

    Range("A1").Select

    ActiveSheet.Paste

    Sheets("Report").Select

    Range("A1").Select

End Sub

Einen Button zum Bestätigen der Datei habe ich angelegt. Beim dazu notwendigen Code stehe ich aber total auf dem Schlauch. Könnt ihr mir helfen?

Hallo,

Private Sub CommandButton1_Click()

 With lstDateinamen

   If .ListIndex > -1 Then

     Workbooks(.Value).Range("B5:DZ24").Copy Workbooks("Daily Report.xlsm").Sheets("Daten").Range("A1")

   End If

 End With

End Sub

Gruß Uwe

Hallo,
danke für die schnelle Antwort. Ich habe den Code so hereinkopiert, aber ich bekomme ein Fehlermeldung.

Zitat:Laufzeitfehler 438 - Objekt unterstützt diese Eigenschaft oder Methode nicht

Folgender Quellcode ist in der gesamten Mappe hinterlegt

Code:
Private Sub cmdCancel_Click()

    Unload Me

End Sub

_____________________________________________________

Sub FormAufrufen()

frmAufruf.Show

End Sub

_____________________________________________________

Private Sub cmdOK_Click()

  With lstDateinamen

   If .ListIndex > -1 Then

     Workbooks(.Value).Range("B5:DZ24").Copy Workbooks("Daily Report.xlsm").Sheets("Daten").Range("A1")

   End If

 End With

End Sub

______________________________________________________

Private Sub UserForm_Initialize()

Dim wkb As Workbook

    For Each wkb In Workbooks

        lstDateinamen.AddItem wkb.Name

    Next wkb

Set wkb = Nothing

End Sub

Wo ist dort der Denkfehler?!

Hallo,

da fehlte noch das Worksheet. Neuer Versuch:

Private Sub CommandButton1_Click()

 With lstDateinamen

   If .ListIndex > -1 Then

     Workbooks(.Value).Worksheets(1).Range("B5:DZ24").Copy Workbooks("Daily Report.xlsm").Sheets("Daten").Range("A1")

   End If

 End With

End Sub

Gruß Uwe

Klasse! Jetzt funktioniert es so, wie es soll! Herzlichen Dank.

Gibt es evtl die Möglichkeit, dass der Code einmal kurz erklärt wird? Damit ich es auch verstehe Angel

Hallo,

ich hoffe, das es so verständlicher ist:

Private Sub CommandButton1_Click()

 'Angaben mit einem vorangesetztem Punkt beziehen sich auf die ListBox

 With lstDateinamen

   'nur wenn etwas ausgewählt/markiert ist, soll kopiert werden

   'wenn nichts ausgewählt wurde, ist der ListIndex der ListBox = -1

   If .ListIndex > -1 Then

     'Quellbereich wird in Zielbereich kopiert (ohne Selects/Activates)

     Workbooks(.Value).Worksheets(1).Range("B5:DZ24").Copy Workbooks("Daily Report.xlsm").Sheets("Daten").Range("A1")

   End If

 End With

End Sub

Gruß Uwe

Hallo,

danke für die Erklärung. Das hat schon sehr geholfen.

Leider muss ich das Thema noch einmal hochholen. Ich möchte in diesem Script, bevor er den gesamten Inhalt die Mail kopiert, den Inhalt aus den Zellen T1:T2 in den Betreff meiner Mail kopieren.
Irgendwie stehe ich hier aber auf dem Schlauch.

Code:
Sub Versenden_Klicken()

    Dim OutApp As Object, Mail As Object, i

    Dim Nachricht

'Zu kopierender Tabellenbereich

    Range("B3:V39").Select

    Selection.Copy

'Mail öffnen

    Set OutApp = CreateObject("Outlook.Application")

    Set Nachricht = OutApp.CreateItem(0)

    With Nachricht

        .Subject = "Mein Betreff - " // hier möchte ich zu meinem Text noch den Wert aus den Zellen T1:T2 einfügen

        .To = "Empfänger 1"

        .BCC = "Empfänger 2.de"

        .display

    End With

    Set OutApp = Nothing

    Set Nachricht = Nothing

'Wartezeit um Mail zu öffnen

    Application.Wait (Now + TimeValue("0:00:01"))

'Zwischenablage einfügen

    Application.SendKeys ("^v")

End Sub

Könnt ihr mir hier weiterhefeln?

Hallo,

.Subject = "Mein Betreff - " & Range("T1").Value & Range("T2").Value

Gruß Uwe

Hallo,

da war mein Denkfehler. Ich kann als mit Range und value einfach den Wert auslesen und einfügen. Eine Copy-Funktion o.ä. ist nicht notwenig.
Top! Danke!

brooker

Kuwer

brooker

Kuwer

brooker

Kuwer

brooker

Kuwer

brooker