Consolidating information to master sheet

smartpat19

Board Regular
Joined
Sep 3, 2014
Messages
114
Task: Looping a macro through multiple workbooks and extracting a table from one tab then transposing that list to a master to make one long data set of all the workbooks. The end task is to easily create a pivot table using this information. I need the data set I am copying from to be dynamic as some are longer than over

From:
File Name: Alpha group project 10
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]Date0[/TD]
[TD]Date1[/TD]
[TD]Date2 [/TD]
[TD]Date 3[/TD]
[/TR]
[TR]
[TD]Item 1[/TD]
[TD]###[/TD]
[TD]###[/TD]
[TD]###[/TD]
[TD]###[/TD]
[/TR]
[TR]
[TD]Item 2[/TD]
[TD]###[/TD]
[TD]###[/TD]
[TD]###[/TD]
[TD]###[/TD]
[/TR]
</tbody>[/TABLE]

To master:
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]Team[/TD]
[TD]Project[/TD]
[TD]Iteam1[/TD]
[TD]Item2[/TD]
[/TR]
[TR]
[TD]Date0[/TD]
[TD]Alpha[/TD]
[TD]10[/TD]
[TD]###[/TD]
[TD]###[/TD]
[/TR]
[TR]
[TD]Date1[/TD]
[TD]Alpha[/TD]
[TD]10[/TD]
[TD]###[/TD]
[TD]###[/TD]
[/TR]
[TR]
[TD]Date2[/TD]
[TD]Alpha[/TD]
[TD]10[/TD]
[TD]###[/TD]
[TD]###[/TD]
[/TR]
[TR]
[TD]Date3[/TD]
[TD]Alpha[/TD]
[TD]10[/TD]
[TD]###[/TD]
[TD]###[/TD]
[/TR]
</tbody>[/TABLE]








Code:
Sub test()


   Dim strPath As String
   Dim strFile As String
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim wsTarget As Worksheet
   
   Dim rowCountSource As Long
   Dim colCountSource As Long
   Dim rowOutputTarget As Long
   
   Dim lastrow As Long
    Dim LastColumn As Range
    Dim StartCell As Range
    Dim team As Range
    Dim PropertyNumber As Range
    
    Dim rng1 As Range
   




   With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then ' if OK is pressed
            strPath = .SelectedItems(1)
            End If
            End With
   If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
   
   Set wsTarget = ThisWorkbook.Sheets("Data Dump")
   
   'set the initial output row
   rowOutputTarget = 2
   
   'get the first file
   strFile = Dir(strPath & "*.xls*")
   
   'loop throught the excel files in the folder
   Do Until strFile = ""
      
      'don't process the workbook containing this macro
      If strFile <> ThisWorkbook.Name Then
      
         'open the workbook
         Set wbSource = Workbooks.Open(strPath & strFile)
         Set wsSource = wbSource.Worksheets("Cash Flow Template")
         
   wsSource.Select
    Range("I53:I58").Select
   Set rng1 = Range(Selection, Selection.End(xlToRight))
   
   lastrow = Range(rng1).Columns.count
    rng1.Copy
       wsTarget.Range("C2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    
   
   wsSource.Select
   Set team = Range("B54")
   Set PropertyNumber = Range("B53")
   
   team.Copy
   wsTarget.Range("A2:A" & lastrow).Paste
   
     
   
         'update output row
         rowOutputTarget = rowOutputTarget + rowCountSource - 1
         
         'close the opened workbook
         wbSource.Close SaveChanges:=False
      End If
      'get the next file
      strFile = Dir()
   Loop
   
   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing
   
End Sub
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Forum statistics

Threads
1,224,823
Messages
6,181,178
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top