Datei - Zelle auslesen - Dialog!

Frage: Wie kann man aus einer Datei die über einen Dateiauswahldialog auszuwählen ist eine Zelle in eine Übersicht kopieren. Es soll die Möglichkeit bestehen das Tabellenblatt auszuwählen. Die Zelle wird über eine InputBox das Tabellenblatt über eine UserForm abgefragt.

Datei - Zelle auslesen - Dialog - Tabellenblattauswahl...[ZIP, 80 KB]

Code gehört in "UsrForm1":
Option Explicit
Private Sub UserForm_Activate()
ComboBox1.ListIndex = 0
End Sub
Private Sub CommandButton1_Click()
Me.Tag = ComboBox1.Value
Me.Hide
End Sub

Code gehört in ein allgemeines Modul:
Option Explicit
Public Sub Test()
Dim wksSheetZ As Worksheet
Dim wksSheet As Worksheet
Dim wkbBook As Workbook
Dim strCell As String
Dim lngColumn As Long
Dim strTMP As String
Dim lngRow As Long
On Error GoTo Fin:
lngRow = ActiveCell.Row
lngColumn = ActiveCell.Column
strCell = InputBox("Zelle", "Eingabe", "A4")
If Trim(strCell) = "" Then Exit Sub
Application.ScreenUpdating = False
If GetAFile(strTMP) <> "" Then
' Tabellenblattname "Gesamt" bei Bedarf anpassen!!!!
Set wksSheetZ = ThisWorkbook.Worksheets("Gesamt")
Set wkbBook = Workbooks.Open(Dir(strTMP))
For Each wksSheet In wkbBook.Worksheets
UserForm1.ComboBox1.AddItem (wksSheet.Name)
Next wksSheet
UserForm1.Show
Set wksSheet = wkbBook.Worksheets(UserForm1.Tag)
With wksSheet
If .Range(strCell).Value <> "" Then
.Range(strCell).Copy _
wksSheetZ.Cells(lngRow, lngColumn)
'Oder NUR WERT übertragen!!!!
'wksSheetZ.Cells(lngRow, lngColumn) = _
.Range(strCell).Value
Else
wksSheetZ.Cells(lngRow, lngColumn).Value = _
"Zelle ohne Inhalt!"
End If
End With
Else
MsgBox "Keine Datei ausgewählt!"
End If
Fin:
Application.CutCopyMode = False
Set wksSheetZ = Nothing
Set wksSheet = Nothing
If Not wkbBook Is Nothing Then wkbBook.Close False
Set wkbBook = Nothing
Application.ScreenUpdating = True
Unload UserForm1
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub
Private Function GetAFile(strFile As String) As String
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = "C:\"
.Title = "Datei"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewDetails
If .Show = -1 Then
strFile = .SelectedItems(1)
Else
strFile = ""
End If
End With
GetAFile = strFile
End Function

Kommentare

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...