I'm starter with VBA and have managed to complete below code with some help, but have one last task to figure out for making the code as I want it to do. I want to apply below code on a folder with several *.txt files. The code works well but I need to manually move files to different folders and run the code. So to make it more automated I need to do some improvements which I hope I can get some suggestion on.
I have let say 40 *.xls files in the folder, I have also a *.xlsm file with eight sheets named (PC2,4,6...-16) in the same folder; I want to copy the column E from the first *.xls file to the "joined_test.xlsm" sheet PC2(sheet1) column B, then copy column E from *.xls file 2 to "joined_test.xlsm" sheet PC4(sheet2) column B and do this until file 8 column E is copied to sheet PC16(sheet8) column B. Then copy column E from file 9 to "joined_test.xlsm" sheet PC2(sheet1) column C and so on until 8 sheets five columns on each sheet is populated with values from the *.xls files.
Different way to achieve the same result would be to do this instead: From *.xls file 1 copy column E to "joined_test.xlsm" sheet PC2 (sheet1) column B, then open *.xls file 9 and copy column E to "joined_test.xlsm" sheet PC2(sheet1) column C and so on until 8 columns are populated with values in sheet PC2(sheet1). Then select *.xls file 2 copy column E to "joined_test.xlsm" sheet PC4(sheet2) column B, then copy column E from *.xls file 10 to sheet PC4(sheet2) column C and so on.
So to keep the column the same and change sheet for every new open *.xls file or to keep the same sheet and change column for every new open *.xls file, the result of both should be the same.
I guess I need to have some kind of loop in the loop solution, but not really sure how to do it. I appreciate all the help. (I have change the size of the part in the code which I think need to be improved)
Sub Macro8()'' Macro8 Macro'' Keyboard Shortcut: Ctrl+d'Dim MyFolder As String Dim myfile As String Dim folderName As String Dim c As Long Dim k As Long c = 2 k = 2 With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False If .Show = -1 Then folderName = .SelectedItems(1) End If End With myfile = Dir(folderName & "\*.txt") Do While myfile <> "" Workbooks.OpenText Filename:=folderName & "\" & myfile, Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _ TrailingMinusNumbers:=True Cells.Select Selection.Replace What:=".", Replacement:=".", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Columns("E:E").Select Selection.FormatConditions.AddTop10 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1) .TopBottom = xlTop10Top .Rank = 1 .Percent = False End With With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 10498160 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False ActiveWorkbook.SaveAs Filename:=folderName & "\" & Replace(myfile, ".txt", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False Selection.Copy [B][SIZE=14px] 'Windows("Joined_test.xlsm").Activate Workbooks("Joined_test.xlsm").Sheets("PC" & k).Activate Cells(1, c).EntireColumn.Select ActiveSheet.Paste Cells(34, c).Select ActiveCell.FormulaR1C1 = "CC" & k c = c + 1 k = k + 2[/SIZE][/B] 'Ensure Workbook has closed before moving on to next line of code DoEvents 'Get next file name myfile = Dir Loop For Each wb In Workbooks If wb.Name <> ThisWorkbook.Name Then 'wb.SaveAs Filename:=Path & wb.Name ', FileFormat:=51 wb.Close False End If Next wb 'ThisWorkbook.Close False 'Message Box when tasks are completed MsgBox "Task Complete!" ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub[/I][I][/I]