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]
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