Copy cells from 4 w'sheets in multiple w'books to 1 w'sheet in 1 w'book

Joined
Jun 2, 2011
Messages
1
Reaction score
0
Hello

As somebody with no coding experience, I have a question re the coding below if that is ok;

Next month, I am being sent 200 project workbooks, each consisting of 4 worksheets where the data in the first worksheet in each workbook is standardised (as is all worksheets 2s, 3s and 4s in each workbook) but there is no standardisation between worksheet 1, 2, 3 and 4 within each workbook. The workbooks being sent to me for Quarter 1 reporting and will be put in a folder labelled 2011Q1R.
I need to consolidate the workbooks by;

1) Creating a consolidated standardised master workbook which consists of one worksheet with an embedded macro (button) which pulls all the data from each worksheet within each project workbook (not the workbook itself) and arranges it into a one-row entry so that I am left with a standardised workbook with single row entries for each of the project workbooks in the Q1 folder
2) I will receive approx 200 workbooks every three months, placed in 2011 Q2R etc which will need to be added to the master workbook which I assume can be done using the macros in 1 with a little tweaking i.e. source

Efforts so far have amounted to having a consolidation worksheet with two macro buttons, the first of which draws in all the worksheets from the workbooks (not the data) in the folder to the consolidation workbook while the second macro button uses 4 versions of the inital coding below (1 for each worksheet) along with recorded a macro that ensures all data from one workbook is on one row (the initial coding below puts each worksheet data on subsequent rows), run by way of an overarching subroutine. As I am sure you can tell, apart from dragging the workbooks and not the data, the macros also only consolidate 1 workbook. Would there be some way of tweaking the coding below so that I can achieve (1) above or would it need a completely new macro?

I hope this makes sense but any questions, please ask. I have also posted this on http://www.mrexcel.com/forum/showthread.php?p=2737865#post2737865

Thanks in advance for any help you may be able to provide
Thanks
Andrew

Code:
Public Sub CopyCells2()
Dim TargetRow As Long
Dim TargetCol As Integer


'CONFIG HERE
Const TargetSheets As String = "consolidation"
Const SourceCells As String = "C4,c6"
Const SourceSheet As String = "delivery confidence"

For Each TargSh In Split(TargetSheets, ",")
With ThisWorkbook.Sheets(TargSh)
TargetRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
TargetCol = 0
For Each celladdr In Split(SourceCells, ",")
TargetCol = TargetCol + 1
.Cells(TargetRow, TargetCol).Value = _
ThisWorkbook.Sheets(SourceSheet).Range(celladdr).Value
Next celladdr
End With
Next TargSh
End Sub

Sub GetSheets()
Path = "H:\Bod\GMPP\Pilot data\pilot\"
Filename = Dir(Path & "*.xls")

Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub

Sub RunMacrosRun()

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Dim strDate As String
Dim cmt As Comment

strDate = "dd-mmm-yy hh:mm:ss"
Set cmt = ActiveCell.Comment

If cmt Is Nothing Then
Set cmt = ActiveCell.AddComment
cmt.Text Text:="Data Merged on" & Chr(10) & Format(Now, strDate) & Chr(10)
Else
cmt.Text Text:=cmt.Text & Chr(10) & Format(Now, strDate) & Chr(10)
End If

With cmt.Shape.TextFrame
.Characters.Font.Bold = False
End With

Application.Run "CopyCells"
Application.Run "Copycells2"
Application.Run "Copycells3"
Application.Run "Copycells4"
Application.Run "MacroAP2"
Application.Run "EE4A"
End Sub
 
Last edited:
Back
Top