Hallo!

Habe mal versucht den Code umzuschreiben. Ist aber ungetestet, da ich die Ausgangsdateien nicht habe. Da ich mir nicht sicher war, bin ich davon ausgegangen, dass der Code aus deiner Übersicht (die auch das Ziel vom Kopieren ist) gestartet wird. Ich habe die zwei Funtionen zusammengefügt, das öffnen der Ziedatei rausgenommen, die Zuordnung der Sheets geändert und zwei Sachen umgestellt. Den COde einfach der Schaltfläche zuweisen. Müsste eigentlich klappen. Viele Grüße

Sub eineSpalte()


 Dim objWSSource As Worksheet
 Dim objWSTarget As Worksheet

 ' das sollte deine Übersicht sein
 Set objWSTarget = ActiveSheet
  Application.ScreenUpdating = False
'
' Sammeldatei merge__chr.txt öffnen
   Workbooks.OpenText Filename:= _
       "xxx\merge__chr.txt", _
       Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
       xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
       Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
       Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
       Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
       , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
       Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
       28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
       Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
       41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1)), _
       DecimalSeparator:=".", ThousandsSeparator:=",", TrailingMinusNumbers:= _
       True
    'nach dem öffnen ist das aktiv und dient als quelle
    Set objWSSource = ActiveSheet
    
   'Zellen Kopieren - Entweder einen ganzen Bereich z.B. Range("A1:A5") oder eine einzelne Zelle
   'z.B. Range("A1") oder eben über den Namen einer Zelle oder Zellbereichs Range("CELLNAME")
   'ggf. hier eine Schleife beginnen oder die nächsten Zeilen für jeden Datensatz einzeln
   'aufrufen
   
   'Zeile 1
   objWSTarget.Range("A1:K1").Value = objWSSource.Range("F2:F12").Value
   
   'Zeile 2
   objWSTarget.Range("A2:K2").Value = objWSSource.Range("F13:F23").Value
   
   'Zeile 3
   objWSTarget.Range("A3:K3").Value = objWSSource.Range("F24:F34").Value
   
   'Zeile 4
   objWSTarget.Range("A4:K4").Value = objWSSource.Range("F35:F45").Value
   
   'Zeile 5
   objWSTarget.Range("A5:K5").Value = objWSSource.Range("F46:F56").Value
   
   'Zeile 6
   objWSTarget.Range("A6:K6").Value = objWSSource.Range("F57:F67").Value
   
   'Zeile 7
   objWSTarget.Range("A7:K7").Value = objWSSource.Range("F68:F78").Value
   
   'Zeile 8
   objWSTarget.Range("A8:K8").Value = objWSSource.Range("F79:F89").Value
   
   'END COPY-PASTE-BLOCK
   'ziel aktivieren um später nicht überrascht zu werden, falls eine andere mappe noch auf ist
    objWSTarget.activate
     
   'Quelldatei ohne Speichern schließen
   objWSSource.Parent.Close False
   
   
   'Runden

   For Each cell In [A1:K8]
       cell.Value = WorksheetFunction.Round(cell.Value, 3)
   Next cell
   
   'Ordner Tabellen leeren
   Kill "xxx\*.txt"
   
    'Bilschirmaktualisierung einschalten
   Application.ScreenUpdating = True
    
End Sub