master file macro
 

I have a workbook created that contains columns A to f
and rows 1 to 32 that contain info about printers that
always remains the same. Then from Columns G to w(only
row 1) I have headings that always remain the same. Then
in the cells beneath these columns I have figures that
are linked to web queries that I have on sheet2(We have
to pay per printed page so we need a way to account for
this for data anlaysis, the printer meters are accessed
through a browser so this was a way I thought of to do
it). This way when I update the queries, the figures
automatically update. Then i have a macro created that
saves a copy of the workbook at the end of each month
with the .bak extension. What I need is an effective way
to create a master file that will have the columns a to f
and rows 1 to 32 appear only once and then add on the
columns from g to w from each of the .bak files whether
they have a figure in each cell or not. There are many
empty cells.So it would look like this:




--Cols stay same--------------- --cols to add each mnth--

Location Xerox Desc Name Serial# Pages Printed Copy Meter

Add cols & headings for Aug Sept
and so on until end of year.Then
start new master for new year


I was looking at a macro from a previous post maybe
somehow this can be reworked, please help!!! I need this
asap. If you have any suggestions on a better method I am
all ears!:

Sub WorksheetCompilation()
Dim flName As String, Path As String
Dim Master As Range, rgInput As Range, rgOutput As Range,
rwInput As Range
Dim nRowsOutput As Integer, i As Integer
Set Master = ThisWorkbook.Worksheets(1).Range("$a$1")
nRowsOutput = 0
Path = InputBox("Enter the path to folder containing
workbooks to be compiled")
If Right(Path, 1) < "\" Then Path = Path & "\"
flName = Dir(Path & "*.xls")
If flName = "" Then Exit Sub
For i = 1 To 1000
flName = Dir
Select Case flName
Case ""
Exit For
Case "Master.xls"
Case Else
Workbooks.Open Filename:=Path & flName
With ActiveWorkbook.Worksheets("Sheet2").UsedRange
For Each rwInput In .Rows
If rwInput.Row = 1 Then
Else
If rwInput.Cells(1, 4) < "" Then
rwInput.Cells.Copy
Destination:=Master.Offset(nRowsOutput, 0)
nRowsOutput = nRowsOutput + 1
Else
End If
End If
Next rwInput
ActiveWorkbook.Close savechanges:=False
End With
End Select
Next i
End Sub