AW: Export in bestehende Exceldatei
05.04.2012 08:43:59
fcs
Hallo Tripler,
wie von Reinhard beschrieben kann die Syntax für GetOpenFilename so nicht funktionieren.
ich schlage eine der beiden folgenden Varianten vor.
Gruß
Franz
Sub QC_Export()
Dim varName As Variant
Dim sPfad As String, sDrive As String
Dim wbQuelle As Workbook, wbZiel As Workbook
Set wbZiel = ActiveWorkbook
sPfad = "C:\Users\Public\Test\Data"
sDrive = Left(sPfad, InStr(1, sPfad, ":") - 1)
If sDrive Left(VBA.CurDir, InStr(1, VBA.CurDir, ":") - 1) Then
VBA.ChDrive Drive:=sDrive
End If
VBA.ChDir Path:=sPfad
varName = Application.GetOpenFilename("Files(*.xls),*.xls")
If varName = False Then GoTo Beenden
Application.EnableEvents = False
Set wbQuelle = Workbooks.Open(Filename:=varName, ReadOnly:=True)
With wbQuelle
.Worksheets("Dateiname").Copy After:=wbZiel.Worksheets(wbZiel.Worksheets.Count)
.Close False
End With
Beenden:
Application.EnableEvents = True
Set wbQuelle = Nothing
Set wbZiel = Nothing
End Sub
Sub QC_Export2()
Dim varName As Variant
Dim sPfad As String, sDrive As String
Dim wbQuelle As Workbook, wbZiel As Workbook
Set wbZiel = ActiveWorkbook
sPfad = "C:\Users\Public\Test\Data"
sDrive = Left(sPfad, InStr(1, sPfad, ":") - 1)
If sDrive Left(VBA.CurDir, InStr(1, VBA.CurDir, ":") - 1) Then
VBA.ChDrive Drive:=sDrive
End If
VBA.ChDir Path:=sPfad
With Application.FileDialog(msoFileDialogOpen)
.Title = "Datei mit Blattname auswählen"
.FilterIndex = 3
.InitialFileName = "Blatt*.xls"
If .Show = -1 Then
varName = .SelectedItems(1)
Application.EnableEvents = False
Set wbQuelle = Workbooks.Open(Filename:=varName, ReadOnly:=True)
With wbQuelle
.Worksheets("Dateiname").Copy After:=wbZiel.Worksheets(wbZiel.Worksheets.Count)
.Close False
End With
End If
End With
Beenden:
Application.EnableEvents = True
Set wbQuelle = Nothing
Set wbZiel = Nothing
End Sub