Datei öffnen, kopieren schliessen
chrissi92
mit nachfolgendem Makro möchte ich aus einer UF.Listbox Dateien
an eine Arbeitsmappe hinzufügen.
Dies dauert jedoch sehr lange z.B. bei 2 Dateien Größe (96kb) ca. 10 Sec.
Gibt es eine elegantere Lösung?
Sub Tag_zu_Bericht_Oeffnen()
sPath = ThisWorkbook.Path & "\Tag\"
For I = 0 To LstRG2.ListCount - 1
If LstRG2.Selected(I) Then
sFile = LstRG2.List(I) & ".xlsx"
Workbooks.Open sPath & sFile
Windows(sFile).Activate
Workbooks(sFile).Worksheets("Bericht").Activate
Workbooks(sFile).Worksheets("Bericht").Copy after:=Workbooks( _
"Tagesdaten.xlsm").Worksheets("Tag")
Windows(sFile).Activate
ActiveWindow.Close savechanges:=False
End If
Next I
Me.Hide
U1.Hide
Workbooks("Tagesdaten.xlsm").Worksheets("Tag").Select
Range("A22").Select
End Sub
Gruß
Chrissi