PC Review


Reply
Thread Tools Rate Thread

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

 
 
New Member
Join Date: Jun 2011
Posts: 1
 
      2nd Jun 2011
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/showthr...65#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 by plant007; 2nd Jun 2011 at 11:53 AM.. Reason: putting tags around code
 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Copy Sheet to new Sheet and clear cells on original sheets Boiler-Todd Microsoft Excel Misc 7 23rd Sep 2009 10:02 PM
Re: Copy range on multiple sheets into one sheet Ron de Bruin Microsoft Excel Programming 3 30th May 2009 01:57 PM
Conditionally copy from multiple sheets to one sheet Pam Microsoft Excel Programming 2 29th Apr 2009 10:30 PM
Copy non blank cells from 1 sheet to multuiple sheets waxback Microsoft Excel Programming 4 16th Jun 2008 09:28 PM
Copy Multiple Sheets Into One Sheet Michael Microsoft Excel Discussion 4 27th Jun 2007 12:39 AM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 05:18 AM.