Datei auslesen in eine andere Tabelle einfügen.

[BasicC]

Also es ist kein Fehler mehr da.
Nur ist das Problem gerade. Das wenn ich ein neuen Wert suche und ihn in das gleiche arbeitsblatt von dem anderen einfügen möchte kommt der nicht eine Spalte weiter rein sondern direkt unter das vorherige.

Private Sub CommandButton1_Click()
    'Testwerte. Müssen noch angepasst werden
    Const C_SRC_SEARCH_RANGE = "B:B"                        'Suchbereich
    'Const C_TRG_WS_NAME = "Daten"
    Const C_COLNR_I = 9                                     'i ist Spalte 9
    
    Dim srcWb As Workbook
    Dim srcWs As Worksheet
    Dim trgWb As Workbook
    Dim trgWs As Worksheet
    Dim r As Range
    Dim trgLastRowNr As Long
    Dim actAlerts As Boolean
    Dim C_TRG_WS_NAME As String
    Dim srcPath As String
    Dim srcSearchValue As String
  '  Dim trgColNr As Long
    'Dateipfad ermitteln
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Add "CSV Files", "*.csv"
        .Filters.Add "All Files", "*.*"
        .FilterIndex = 1
        .Show
        If .SelectedItems.Count = 0 Then
            MsgBox "Keine Datei ausgewählt, Vorgang wird abgebrochen", vbExclamation + vbOKOnly
            Exit Sub
        End If
        srcPath = .SelectedItems(1)
    End With
        
    'Suchwert abfragen
    srcSearchValue = InputBox("Suchwert in Spalte B")
    C_TRG_WS_NAME = InputBox("Name des Arbeitsblattes")
    'Ziel Workbook
    Set trgWb = ActiveWorkbook
    
    'Quell Workbook und Sheet
    Set srcWb = Workbooks.Add(srcPath)
    Set srcWs = srcWb.Worksheets(1)
    
    'Das CSV ist als Text in der ersten Spalte - Das ganze mit TextToColumns auf die Spalten aufteilen
    
    actAlerts = Application.DisplayAlerts   'aktuelle DisplayAlerts merken
    Application.DisplayAlerts = False       'DisplayAlerts ausschalten
    srcWs.Range("A:A").TextToColumns Destination:=srcWs.Range("A1"), DataType:=xlDelimited, Semicolon:=True
    Application.DisplayAlerts = actAlerts   'DisplayAlerts zurücksetzen

    'Die Spalte B durchsuchen
    For Each r In srcWs.Range(C_SRC_SEARCH_RANGE)
        If r.Value = srcSearchValue Then
            'Falls das Ziel-Sheet noch nicht definiert wurde, das machen (wird nur beim ersten Treffer ausgeführt)
            If trgWs Is Nothing Then
                Set trgWs = createOrGetWorksheet(trgWb, C_TRG_WS_NAME)
                trgLastRowNr = trgWs.Cells.SpecialCells(xlCellTypeLastCell).Row
               ' trgColNr = trgWs.Cells.SpecialCells(xlCellTypeLastCell).Column + 1
            End If
            'Nächste Freie Zeilen ermitteln
            trgLastRowNr = trgLastRowNr + 1
            'Wert aus Spalte I übernehmen
            trgWs.Cells(trgLastRowNr, 1) = srcWs.Cells(r.Row, C_COLNR_I).Value
         '  trgWs.Cells(trgLastRowNr, 1) = srcWs.Cells(r.Row, trgColNr).Value
        End If
    Next r
    srcWb.Close False
  
    End Sub

'/**
' * Gibt ein Worksheet anhand des Namens zurück. Exisitert es noch nicht, wird es erstellt
' * @param  Workbook
' * @param  String
' * @return Worksheet
' */
Private Function createOrGetWorksheet(ByRef ioWb As Workbook, ByVal iWsName As String) As Worksheet
    Dim ws As Worksheet
    For Each ws In ioWb.Worksheets
        If (UCase(ws.Name) = UCase(iWsName)) Then
            Set createOrGetWorksheet = ws
            Exit Function
        End If
    Next ws
    Set createOrGetWorksheet = ioWb.Worksheets.Add
    createOrGetWorksheet.Name = iWsName
End Function

 

[Yaslaw]

Das ist doch schon mehr Infos als vorher.
Und ja, das macht genau was du beschreibst. Der Code geht in die Nächste Zeile. Ich sehe nirgends, dass die Spalten hochgezählt werden.
Ich habe den ganzen Thread nochmals durchgelesen. Bis jetzt stand nie was von "gleiches Worksheet, neue Spalte" sondern nur "Worksheet von Hand auswählen".
Wie zum Teufel sollen wir wissen was falsch geht, wenn du nicht erklärst, was es denn wirklich machen soll.

 

[BasicC]

Sorry dachte hätte es erwähnt. Was muss ich nun ändern damit ich gleiches Worksheet nutze ?