Daten aus ausgewähltem Blatt kopieren

[brooker]

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?

[Kuwer]

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

[brooker]

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

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?!

[Kuwer]

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

[brooker]

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

[Kuwer]

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

[brooker]

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?

[Kuwer]

Hallo,

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

Gruß Uwe

[brooker]

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!