Consolidating information to master sheet

smartpat19

Board Regular
Joined
Sep 3, 2014
Messages
111
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
Date0Date1Date2 Date 3
Item 1############
Item 2############

<tbody>
</tbody>

To master:
TeamProjectIteam1Item2
Date0Alpha10######
Date1Alpha10######
Date2Alpha10######
Date3Alpha10######

<tbody>
</tbody>








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
 

Some videos you may like

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

Watch MrExcel Video

Forum statistics

Threads
1,108,766
Messages
5,524,772
Members
409,600
Latest member
Dunnowhatfor

This Week's Hot Topics

Top