Hallo ich bekomm es nicht hin.
Also ich möchte ja den Wert der in B2 steht als Blattnamen nehmen der bei import kopiert werden soll.
Wo muss ich jetzt meien Codes anpassen?
Hab folgendes gemacht ohne Erfolg:
Modul 1:
Option Explicit
Sub Import_mit_Dialog()
Dim Quelle As Object, Ziel As Object
Dim Datei As String
On Error GoTo Fehler
'Dialog "Datei öffnen" anzeigen
Datei = Application.GetOpenFilename("Excel-Dateien(*.xlsx),*xlsx")
'Abbrechen falls keine Datei ausgewählt
If Datei = "Falsch" Then
MsgBox "Keine Datei ausgewählt!", , "Abbruch"
Exit Sub
End If
'MsgBox "Ausgewählte Datei: " & Datei, , ""
'Ausgewählte Datei öffnen
Workbooks.Open Filename:=Datei
<strong>
Set Ziel = ThisWorkbook.Worksheets(3)
blatt = Ziel.Range("B10").Value
Set Quelle = ActiveWorkbook.Worksheets(blatt)</strong>
'kopieren und einfügen
Quelle.UsedRange.Copy
Ziel.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Close Application.DisplayAlerts = True
MsgBox "Import abgeschlossen!"
'Speicher freigeben
Set Quelle = Nothing
Set Ziel = Nothing
Application.DisplayAlerts = False
Exit Sub
Fehler:
Set Quelle = Nothing
Set Ziel = Nothing
MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
& "Beschreibung: " & Err.Description _
, vbCritical, "Fehler"
End Sub
In einem zweiten Modul:
Function FindWorksheet(wbk As Workbook, sSheetName As String) As Worksheet
Dim wsh As Worksheet
With wbk
For Each wsh In wbk.Worksheets
If wsh.Name = sSheetName Then
Set FindWorksheet = wsh
Exit For
End If
Next
End With
End Function
Und in DieseArbeitsmappe dann:
Sub Test()
Dim wsh As Worksheet
Set wsh = FindWorksheet(ActiveWorkbook, "blatt")
If wsh Is Nothing Then
MsgBox "Gesuchte Tabelle ist nicht vorhanden!"
End If
End Sub
Wie bekomm ich das nun hin dwenn in Zelle B10 nun angenommen Angebot steht. Er beim importieren die gewählte Datei nach den Tabellennamen Angebot durchsucht und diese dann kopiert?
|