Forum Discussion
Taking one column from many excel files and putting them into one next to each other?
I have many excels (like more than 100), which all have different data but are all the same excel (same structure). Is it possible, if I want one particular column of data from each of the excels, and to put them automatically into one excel file next to each other? So it would be like excel1- culumn of data, next to it excel2- column of data etc... Is there any way to do this ? I tried playing with power query, but the only thing I managed to do is to put all the columns into one, but I want all the columns to be separate next to each other...
I'll assume that the workbooks are all in the same folder, and that this folder does not contain other workbooks that you do not want to process. Run the following macro:
Sub CombineColumns() Const Col = "M" ' column to copy Dim strPath As String Dim strFile As String Dim c As Long Dim wbkS As Workbook Dim wshS As Worksheet Dim wbkT As Workbook Dim wshT As Worksheet With Application.FileDialog(4) ' msoFileDialogFolderPicker .Title = "Please select the folder with the workbooks" If .Show Then strPath = .SelectedItems(1) If Right(strPath, 1) <> "\" Then strPath = strPath & "\" End If Else Beep Exit Sub End If End With Application.ScreenUpdating = False Set wbkT = Workbooks.Add(xlWBATWorksheet) Set wshT = wbkT.Worksheets(1) strFile = Dir(strPath & "*.xls*") Do While strFile <> "" Set wbkS = Workbooks.Open(Filename:=strPath & strFile) Set wshS = wbkS.Worksheets(1) c = c + 1 wshS.Columns(Col).Copy Destination:=wshT.Columns(c) wbkS.Close SaveChanges:=False strFile = Dir Loop Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
4 Replies
I'll assume that the workbooks are all in the same folder, and that this folder does not contain other workbooks that you do not want to process. Run the following macro:
Sub CombineColumns() Const Col = "M" ' column to copy Dim strPath As String Dim strFile As String Dim c As Long Dim wbkS As Workbook Dim wshS As Worksheet Dim wbkT As Workbook Dim wshT As Worksheet With Application.FileDialog(4) ' msoFileDialogFolderPicker .Title = "Please select the folder with the workbooks" If .Show Then strPath = .SelectedItems(1) If Right(strPath, 1) <> "\" Then strPath = strPath & "\" End If Else Beep Exit Sub End If End With Application.ScreenUpdating = False Set wbkT = Workbooks.Add(xlWBATWorksheet) Set wshT = wbkT.Worksheets(1) strFile = Dir(strPath & "*.xls*") Do While strFile <> "" Set wbkS = Workbooks.Open(Filename:=strPath & strFile) Set wshS = wbkS.Worksheets(1) c = c + 1 wshS.Columns(Col).Copy Destination:=wshT.Columns(c) wbkS.Close SaveChanges:=False strFile = Dir Loop Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
- Pavol_GoralkaCopper Contributor
Thank you very much it works perfectly!
You can change the line
Set wshS = wbkS.Worksheets(1)
to
Set wshS = wbkS.Worksheets("SpecificSheet")
where SpecificSheet is the name of the worksheet to copy a column from.