Sub ImportData() ' ' Copy Data from one workbook to the Current Workbook ' Place the macro file in the same folder as the source file ' p = ThisWorkbook.Path & "\" f = Dir(p & "*.xlsx") Application.ScreenUpdating = False thrn = ThisWorkbook.Sheets(1).Range("A100000").Row With ThisWorkbook.Sheets(1) .Range("A1:T" & thrn).ClearContents End With Do While f <> "" If f <> ThisWorkbook.Name Then Set wb = GetObject(p & f) With wb.Sheets(1) rn = .Range("A100000").End(xlUp).Row ThisWorkbook.Sheets(1).Range("A1:T" & rn).Value = .Range("A1:T" & rn).Value MsgBox "Format Complete." End With End If f = Dir Loop End Sub Sub Text_to_Columns()
'Formatted Data Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :="|", 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, 3), Array(17, 1), Array(18, 1), _ Array(19, 1), Array(20, 1)), DecimalSeparator:=".", ThousandsSeparator:=",", _ TrailingMinusNumbers:=True Columns("A:T").Select Selection.Copy End Sub Sub Copy_Back() ' ' Copy back the formatted data to the source file ' p = ThisWorkbook.Path & "\" f = Dir(p & "*.xlsx") Application.ScreenUpdating = False thrn = ThisWorkbook.Sheets(1).Range("A100000").Row Do While f <> "" If f <> ThisWorkbook.Name Then Set wb = GetObject(p & f) With wb.Sheets(1) rn = .Range("A100000").End(xlUp).Row .Range("A1:T" & rn).ClearContents .Range("A1:T" & thrn).Value = ThisWorkbook.Sheets(1).Range("A1:T" & thrn).Value MsgBox "Complete." End With End If f = Dir Loop ThisWorkbook.Sheets(1).Range("A1:T" & thrn).ClearContents wb.Save 'Make sure the source file is already open End Sub Sub ExecConvert() ' 'Execute Macros ' Call ImportData Call Text_to_Columns Call Copy_Back End Sub