[Solved] Add transpose function

[Frank]

Hello,
I managed to get the macro shown here (https://www.exceldemy.com/excel-macro-extract-data-from-multiple-excel-files/) under 4. Extract Data from Selected Files... to work, but would like to transpose the data. The data I want to extract is located in F16:F20 in each file and I would like to transpose it to A1:A5 (first file), B1:B5 (second file) and so on.
Thank you,
Frank

 

[Rubayed Razib]

Hello,
I managed to get the macro shown here (https://www.exceldemy.com/excel-macro-extract-data-from-multiple-excel-files/) under 4. Extract Data from Selected Files... to work, but would like to transpose the data. The data I want to extract is located in F16:F20 in each file and I would like to transpose it to A1:A5 (first file), B1:B5 (second file) and so on.
Thank you,
Frank

thanks a lot Frank for your response.
First of all, there might be some confusion regarding to your question. That if you want to transpose data stored in the range of cell F16:F20, then the transposed data mustnot be in the same column. But the example output range you have shown, A1:A5, is placed in the same column A. I am interpreting this as just some typing error.
the values assumed to be stored in range of cell F16:F20 in each file. as shown below.

Now I assumes that you want to place the files in to a new workhsheet, where the extracted data will be placed with transposed value. the code is given below

Sub ExtractDataAndTranspose()
    Dim selectedFiles As FileDialog
    Dim currentWorkbook As Workbook
    Dim currentSheet As Worksheet
    Dim inputr As Range
    Dim outputR As Range
    Set selectedFiles = Application.FileDialog(msoFileDialogOpen)
    selectedFiles.AllowMultiSelect = True
    selectedFiles.Show
    fileCount = selectedFiles.SelectedItems.Count
    Set masterSheet = ActiveWorkbook.ActiveSheet
    j = 0
    For i = 1 To fileCount
        Set currentWorkbook = Workbooks.Open(selectedFiles.SelectedItems(i))
        Set currentSheet = currentWorkbook.Sheets(1)
        Set inputr = currentSheet.Range("F16:F20")
        Set outputR = masterSheet.Cells(i, 1)
        inputr.Copy
        outputR.PasteSpecial Transpose:=True
        currentWorkbook.Close SaveChanges:=True
    Next i
End Sub

the output data will look something like this

In this code you need to choose the file using the file dialogue box and then the files values stored in the cell F16:F20 will be extracted and be stored in the active work book sheet
A1:E1 for first file data
A2:E2 for second file data
A3:E2 for third file data
you can change the code if you have data stored in other range of cells. in the line Set inputr = currentSheet.Range("F16:F20"), just change the range F16:F20 with your desired range.

 

[Frank]

Hello,
Thanks a bunch.
This does partially address my problem. I have some 200+ files with the data stored in F16:F20 and yes, having this transposed like this works. The files are not in alphabetic order though. Furthermore, what is missing are the file names. Ideally, I would like all file names (even better without the .xls) in column A and then the data from each file stored in F16:F20 transposed to columns B1:F1, B2:F2 and so on.
I hope this makes sense?
Thanks,
Frank

 

[Rubayed Razib]

Greetings Frank,
Thanks a lot for posting your queries again. Actually, the file serial actually depends upon the serial in which they are now sorted in your pc. If you want a different order, then the files need to sort on your pc according to your preferred order. If that does not solve your problem, please let us know.
Secondly, yes, you can add the file name without the extension part in the sheet. use the modified code given below.

Sub ExtractDataAndTranspose()
    Dim selectedFiles As FileDialog
    Dim currentWorkbook As Workbook
    Dim currentSheet As Worksheet
    Dim inputr As Range
    Dim outputR As Range
    Set selectedFiles = Application.FileDialog(msoFileDialogOpen)
    selectedFiles.AllowMultiSelect = True
    selectedFiles.Show
    fileCount = selectedFiles.SelectedItems.Count
    Set masterSheet = ActiveWorkbook.ActiveSheet
    j = 0
    For i = 1 To fileCount
        Set currentWorkbook = Workbooks.Open(selectedFiles.SelectedItems(i))
        Set currentSheet = currentWorkbook.Sheets(1)
        Set inputr = currentSheet.Range("F16:F20")
        Set outputR = masterSheet.Cells(i, 2)
        inputr.Copy
        file_name_with_ext = currentWorkbook.Name
        masterSheet.Cells(i, 1) = Replace(file_name_with_ext, ".xlsx", "")
        outputR.PasteSpecial Transpose:=True
        currentWorkbook.Close SaveChanges:=False
    Next i
End Sub

After running the code the output wil look something like the below.

Hope this solve your issue, please dont hesitate to inform us if you have further query.

 

[Frank]

Thank you! This works a treat! F