# Datei auslesen in eine andere Tabelle einfügen.



## BasicC (25. Mai 2018)

Hallo Leute

ich hab echt kein Plan von VBA.
Vorhandene Datei: - eine .txt Datei die hat mehrere Zahlen , Werte etc.

Meine Aufgabe ist es ein Code zu schreiben, welches die Datei mit einem Button öffnet( also da dachte ich dann mache ich ein Worksheet auf nenne es Start setze ein Button hin das Öffnen heißt der öffnet mir den Explorer und ich kann die jeweilige Datei auswählen).

So nachdem die ausgewähle Datei dann in der Excel Datei in einem neuen Arbeitsblatt geöffnet ist, soll ich ein Code schreiben welches mir die Zeilen ausliest von spalte B und wenn es auf Spalte B ein Buchstaben entdeckt soll es mir in ein neues Arbeitsplatt hinzufügen, wenn er das gemacht hat soll er noch den Wert bei Spalte i4 mitnehmen und ihn darunter im neuen Arbeitsblatt einfügen.


```
Sub CommandButton1_Click()


Dim wsTarget As Worksheet
Dim varDatei As Variant

wsTarget = Worksheet("Datei")

varDatei = Application.GetOpenFilename()
If varDatei = False Then
    MsgBox "Sie haben das Öffnen abgebrochen.", vbInformation, p_cstrAppName
Else
    MsgBox "Ausgewählte Datei:" & vbCrLf & varDatei, vbInformation, p_cstrAppName
End If

Set wsTarget = Worksheets("Datei")
End Sub
```


----------



## Zvoni (25. Mai 2018)

Die Text-Datei ist semicolon-getrennt.
Wieso importierst du sie nicht einach als csv?


----------



## BasicC (25. Mai 2018)

Bitte sehr


----------



## Yaslaw (25. Mai 2018)

Zeile 7 ist fehlerhaft und macht keinen Sinn.
Dito mit Zeile 16.

Gegenfrage. 
Wenn der Code in Start!B:B etwas findet. Soll er dass dann einmal ausführen oder bei jedem treffer?


----------



## BasicC (25. Mai 2018)

Bei jedem Treffer . 
Zeile 7 und 16 sind aus irgendeinem script von dir dachte mach eventuell sinn


----------



## Yaslaw (25. Mai 2018)

Bei jedem Treffer ein neues Sheet anlegen und Wert von I4 hineinkopieren


----------



## BasicC (25. Mai 2018)

Nein bei jedem Treffen bei dem neuen angelegten sheet den wert hinein kopieren 
Und i4 ist als beispiel 
Dann soll es beim nächsten von i5 u.s.w


----------



## Yaslaw (28. Mai 2018)

Und die 4 bei i4? Ist das die Zeile in dem etwas gefunden wurde?


----------



## BasicC (28. Mai 2018)

Ja da ist eine Kelvin Zahl die ungefähr so aussieht 43,82827K

Also bei fast jeder i ten zelle von i ist eine Zahl drin


----------



## Yaslaw (30. Mai 2018)

So auf die Schnelle:

```
Public Sub test()
    'Testwerte. Müssen noch angepasst werden
    Const C_SRC_PATH = "C:\Users\C754943\_TMP\Test3.csv"    'Quelldatei
    Const C_SRC_SEARCH_VALUE = "R308"                       'SuchWert
    Const C_SRC_SEARCH_RANGE = "B:B"                        'Suchbereich
    Const C_TRG_WS_NAME = "TEST"                            'Name des Ziel-Sheets
    
    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
    
    'Ziel Workbook
    Set trgWb = ActiveWorkbook
    
    'Quell Workbook und Sheet
    Set srcWb = Workbooks.Add(C_SRC_PATH)
    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 = C_SRC_SEARCH_VALUE 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
            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
        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
```


----------



## BasicC (30. Mai 2018)

Das ist schonmal super !!. 
Wie könnte ich es ausbauen das ich auf ein command button drücke -> Die Datei auswähle -> und der mir dann sagt nach was möchtest du suchen und mir die Zahlen raushaut .


----------



## Yaslaw (30. Mai 2018)

Die entsprechenden Const durch Variablen ersetzen

```
Dim srcPath As String
    Dim srcSearchValue As String

    '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")
```


----------



## BasicC (30. Mai 2018)

```
Private Sub CommandButton1_Click()

    'Testwerte. Müssen noch angepasst werden
    'Const C_SRC_PATH = "G:\IT\Karaguelle\Messwerte Kopieren\X590_DRL_DI_Mid_Outer_RH.txt"    'Quelldatei
    Dim srcPath As String
    Dim srcSearchValue As String

    '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")
    
    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
    
    'Ziel Workbook
    Set trgWb = ActiveWorkbook
    
    'Quell Workbook und Sheet
   ' Set srcWb = Workbooks.Add(C_SRC_PATH)
    '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 = C_SRC_SEARCH_VALUE 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
            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
        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
End Function
```

Da ist irgendetwas falsch Fehlermeldung: Objektvariable oder With-Blockvariable nicht festgelegt?


----------



## Yaslaw (30. Mai 2018)

Wo kommt die Fehlermeldung?
Zudem musst du natürlich nachher die Datei öffnen, die ausgewählt wurde
C_SRC_PATH und C_SRC_SEARCH_VALUE müssen aus dem Code verschwinden.
Die Anderen Konstanten braucht es aber weiterhin. Die sehe ich bei dir nicht mehr.

```
Public Sub test()
    'Testwerte. Müssen noch angepasst werden
    Const C_SRC_SEARCH_RANGE = "B:B"                        'Suchbereich
    Const C_TRG_WS_NAME = "TEST"                            'Name des Ziel-Sheets
    
    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 srcPath As String
    Dim srcSearchValue As String
    
    '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")
    
    '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
            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
        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
```


----------



## BasicC (30. Mai 2018)

OK. und jetzt eventuell noch wenn man den gesuchten Wert eingegeben hat das man danach sagt mach es nicht automatisch in TEST rein sondern man setzt selber den Namen fest. (falls es geht ob man es immer in test rein machen könnte aber immer eine spalte weiter.)


----------



## Yaslaw (30. Mai 2018)

Gleich wie der Suchwert. C_TRG_WS_NAME aus dem Code durch eine Variabel ersetzen und diese mittels InputBox() befüllen.


----------



## BasicC (30. Mai 2018)

Das habe ich hinbekommen  
Wie mache ich das was ich in den Klammern geschrieben hatte ? 
Das ich es immer in ein Arbeitsblatt kopiere aber jedesmal in eine andere Spalte.
Und es fehlt die Bezeichnung der Spalte wie bekomme ich die hin ?


----------



## Yaslaw (30. Mai 2018)

Du hast eigentlich alles was du dazu brauchst. Einfach mal den Code studieren und versuchen zu verstehen.

```
Dim trgColNr As Long
...
        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, trgColNr).Value
        End If
```


----------



## BasicC (31. Mai 2018)

```
Public Sub Suche()
    'Testwerte. Müssen noch angepasst werden
    Const C_SRC_SEARCH_RANGE = "B:B"                        'Suchbereich
                                'Name des Ziel-Sheets
    
    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 srcPath As String
    Dim srcSearchValue As String
    'Dim C_TRG_WS_Name
    
    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, trgColNr).Value
        End If
        
       '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
        '    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
      '  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
```

Ein Fehler liegt bei createOrGetWorksheet.Name = iWsName  warum ? Verstehe dies nicht .


----------



## Yaslaw (3. Juli 2018)

Was für ein Fehler?
Bitte um Beschreibung Fehlverhalten, Fehlermeldungen etc.
Aber das weisst du ja inzwischen, dass wir diese Infos brauchen.


----------



## BasicC (4. Juli 2018)

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 (4. Juli 2018)

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 (4. Juli 2018)

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


----------

