Sub Main() Dim p As String, fe As String, fileToOpen As String, i As Integer Dim twb As Workbook, ws As Worksheet, ws1 As Worksheet, r As Range p = "C:\User\testfiles\" fe = ".txt" Application.EnableEvents = False Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.DisplayAlerts = False Set twb = ThisWorkbook 'Set ws1 = Workbooks.Add(xlWBATWorksheet).Worksheets(1) For i = 2 To twb.Worksheets.Count 'WorkSheet(1)=Welcome sheet, so skip. Set ws = twb.Worksheets(i) fileToOpen = p & ws.Name & fe If Dir(fileToOpen) = ws.Name & fe Then Workbooks.OpenText _ Filename:=fileToOpen, _ DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, _ Tab:=True, _ Semicolon:=True, _ Comma:=False, _ Space:=False, _ Other:=False, _ FieldInfo _ :=Array(Array(1, 1), Array(2, 1)), _ TrailingMinusNumbers:=True ActiveSheet.UsedRange.Copy Set r = ws.Cells(Rows.Count, "C").End(xlUp).Offset(1) If r.Row < 4 Then Set r = ws.Range("C4") r.PasteSpecial xlPasteValues ActiveWorkbook.Close False End If Next i Application.EnableEvents = True Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True End Sub