Sub t_() t_folder = ThisWorkbook.Path & Application.PathSeparator t_file = Dir(t_folder & "*.txt") If t_file <> "" Then r = 5 Cells(r, 3).CurrentRegion.ClearContents Open t_folder & t_file For Input As #1 Do While Not EOF(1) Line Input #1, t t = Split(t, Chr(9)) Cells(r, 3).Resize(1, UBound(t) + 1) = t r = r + 1 Loop Close #1 End If End Sub
[/vba]
Добрый день. Например так [vba]
Код
Sub t_() t_folder = ThisWorkbook.Path & Application.PathSeparator t_file = Dir(t_folder & "*.txt") If t_file <> "" Then r = 5 Cells(r, 3).CurrentRegion.ClearContents Open t_folder & t_file For Input As #1 Do While Not EOF(1) Line Input #1, t t = Split(t, Chr(9)) Cells(r, 3).Resize(1, UBound(t) + 1) = t r = r + 1 Loop Close #1 End If End Sub
Sub xx() With Application .ScreenUpdating = 0: .EnableEvents = 0: .DisplayAlerts = False Open ActiveWorkbook.Path & "\8037208.txt" For Input As #1 With GetObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") .SetText Input$(LOF(1), 1) .PutInClipboard End With Close #1 With [C5:F5] Range(.Cells, .End(xlDown)).ClearContents .Cells(1).PasteSpecial xlPasteAll .Copy End With .CutCopyMode = 0 .ScreenUpdating = 1: .EnableEvents = 1: .DisplayAlerts = 1 End With End Sub
[/vba]
еще вариант[vba]
Код
Sub xx() With Application .ScreenUpdating = 0: .EnableEvents = 0: .DisplayAlerts = False Open ActiveWorkbook.Path & "\8037208.txt" For Input As #1 With GetObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") .SetText Input$(LOF(1), 1) .PutInClipboard End With Close #1 With [C5:F5] Range(.Cells, .End(xlDown)).ClearContents .Cells(1).PasteSpecial xlPasteAll .Copy End With .CutCopyMode = 0 .ScreenUpdating = 1: .EnableEvents = 1: .DisplayAlerts = 1 End With End Sub