Exportieren einer Zeile in andere Excel - Datei

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: Exportieren einer Zeile in andere Excel - Datei
von: Robin
Geschrieben am: 09.10.2015 14:50:48

Ich möchte gerne folgendes: Eine Importfunktion von einer Excel - Datei in eine andere.
Man soll auf einen Button (Importieren) klicken, dann öffnet sich ein Fenster in dem man den gewünschten Nachnamen einer Person eintragen soll, wenn man diesen Eingegeben hat, soll darauf hin eine andere Excel - Datei in ( Tabelle1) geschlossen
anhand Spalte A durchsucht werden, wenn der Name in Spalte identisch mit der Eingabe ist, soll daraufhin die ganze Zeile importiert werden. Ich hab alles mögliche gegoogelt aber nix gefunden.Hat vielleicht jemand eine Idee wie man das mit dem Zelleninhaltsvergleich anhand einer Eingabe angeht???

Bild

Betrifft: AW: Exportieren einer Zeile in andere Excel - Datei
von: Sepp
Geschrieben am: 10.10.2015 01:07:38
Hallo Robin, (das ist eine Anrede!)
da gibt es mehrere Möglichkeiten.
Eine davon:

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub importAusAndererDatei()
Dim objTable As Object
Dim strFilename As String, strTab As String, strRef As String
Dim strInput As String, strWhere As String
Dim rng As Range

strFilename = "E:\Forum\andere datei.xlsx" 'Datendatei - Anpassen!
strTab = "Tabelle1" 'Tabellenname - Anpassen
strRef = "A1:I1000" 'Datenbereich- Anpassen!

strInput = Application.InputBox("Bitte den gesuchten Namen eingeben:", "Import", Type:=2)

If strInput <> CStr(False) Then
  If Len(strInput) Then
    On Error Resume Next
    Set rng = Application.InputBox("Zielzelle wählen:", "Import", ActiveCell.Address, Type:=8)
    On Error GoTo 0
    If Not rng Is Nothing Then
      strWhere = "WHERE Name='" & strInput & "'"
      
      Set objTable = ExcelTable(strFilename, strTab, strRef, strWhere)
      
      If objTable.RecordCount Then
        rng.CopyFromRecordset objTable
      Else
        MsgBox "Kein Treffer!"
      End If
    End If
  End If
End If

Set objTable = Nothing
Set rng = Nothing
End Sub


Private Function ExcelTable(ByRef Path As String, ByRef Table As String, ByRef SourceRange As String, Optional WhereString As String = "") As Object
Dim SQL As String
Dim Con As String

SQL = "select * from [" & Table & "$" & SourceRange & "] " & WhereString

If Mid(Path, InStrRev(Path, ".") + 1) = "xls" Then
  Con = "Provider=Microsoft.Jet.OLEDB.4.0;" _
    & "Extended Properties=Excel 8.0;" _
    & "Data Source=" & Path & ";"
ElseIf Mid(Path, InStrRev(Path, ".") + 1) Like "xls?" Then
  Con = "Provider=Microsoft.ACE.OLEDB.12.0;" _
    & "Extended Properties=""Excel 12.0;HDR=YES"";" _
    & "Data Source=" & Path & ";"
Else
  Exit Function
End If
Set ExcelTable = CreateObject("ADODB.Recordset")
ExcelTable.Open SQL, Con, 3, 1
End Function

(Es folgt ein Gruß)
Gruß Sepp


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Exportieren einer Zeile in andere Excel - Datei"