Transpose columns from multiples files in mulitple subfolders into rows in a single file

Dear Excel Gurus,

I receive tax returns from different companies in the group every quarter, which needs to be consolidated. The template used by all the companies is same and the ranges to be transposed remain constant.

For examples Range F13:F30 in the "Return template" for all the companies needs to be transposed into one row for each company in the Consolidation file (rows 3:10). This action will be repeated every quarter and the data for each quarter will be pasted one below the other.

I have subfolders for each quarter e.g. D:\2013\Q#. Is there anyway that the macro will prompt me to input the subfolder name (quarter) and then copy the data from the relevant column and transpose it in the Consolidation file.

There are many questions on transposing data on this forum, but I could not find any which met my requirement. Hence I have created a fresh post.

Any help is highly appreciated. Many thanks in advance.


Vijay
Excel 2007


In the last few days, I did more google and put together the below code. This allows me to select the folder where the files are located. However everytime I run the macro, it will overwrite the numbers for the previous quarters as well.

Please can somebody have a look at the code and let me know if it is possible to do the consolidation (copy/transpose/paste) only for the current quarter. Many thanks.

Sub Consolidate()
    Dim thiswb As Workbook, datawb As Workbook
    Dim datafolder As String
    Dim cell As Range, datawblist As Range
    Dim i As Integer, qrow As Integer
    
    Set thiswb = ActiveWorkbook
    i = 17
    'Will find the last row with data in column A and make the range
    'A1:A & Lastrow
    Sheets("Entities").Select
    qrow = Cells(Rows.Count, 1).End(xlUp).Row
    Set datawblist = Range("A1:A" & qrow)
    Sheets("Consolidation").Select
    Cells(i, 4).Select
    
    Call GET_FOLDER_PATH
    
    For Each cell In datawblist
        Workbooks.Open Filename:=MyPath & cell & ".xlsx", ReadOnly:=True
        Set datawb = ActiveWorkbook
        Sheets("VAT Summary 100-4").Select 'change this to the sheet name you need to copy from
        Range("G13").Select
        Do Until ActiveCell.Value = ""
            Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(30, ActiveCell.Column)).Copy
            thiswb.Activate
            Sheets("Consolidation").Select 'change if not sheet1
            Selection.PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, _
                SkipBlanks:=False, _
                Transpose:=True
            ActiveCell.Offset(14, 0).Select
            datawb.Activate
            ActiveCell.Offset(0, 1).Select
        Loop
        datawb.Close SaveChanges:=False
        thiswb.Activate
        Sheets("Consolidation").Select
        i = i + 1
        Cells(i, 4).Select
    Next
    
End Sub

Private Sub GET_FOLDER_PATH()
    Dim MyPath As String
    MsgBox ("Please browse to the required folder and click 'Open'." _
            & vbCr & "No need to select a file")
    MyPath = Application.GetOpenFilename("All Files (*.*),*.*", , "FOLDER REQUIRED")
    If MyPath = "False" Then Exit Sub       ' Cancel button
    '--------------------------------------------------------------------------------
    '- USER  MAY HAVE SELECTED A FILE. check for ".". Remove any file name.
    If InStr(1, MyPath, ".", vbTextCompare) > 0 Then
        For c = Len(MyPath) To 1 Step -1
            If Mid(MyPath, c, 1) = "\" Then
                MyPath = Left(MyPath, c)
                Exit For
            End If
        Next
    End If
    '-------------------------------------------------------------------------------
    MsgBox ("Path = " & MyPath)
End Sub