Impossible? Dynamic copy/paste

[LiAD]

Hi,

I have a list of data contained in a series of files stored on a network.
There is one file for every month, ( file name Jan, Feb etc). Each file has
31 sheets (sheet names 1,2,3 etc) to record certain events every day of the
month. Some days may be empty and have nothing written.

There is then a Summary file which I would like to fill automatically from
the 12 source files (Jan, Feb etc). In Summary i have 5 sheets (a,b,c,d,e). I
would like to find a way of automatically copying data

from the source file - Jan/1 cells d12, e12 & m12
to the Summary file - cells f2, g2 & d2

The next day, Jan 2 i need to take the data from the same file (if its the
same month) but a different sheet, Jan/2 and copy to summary/a/the next
series of empty cells. Alternatively if its the 31 Jan it copies from Jan/31,
the next day it needs to find a different file and sheet - Feb/1 to copy the
data from.

- In the source files, (Jan, Feb etc), I only need to copy from sheets 3 to
33 (there are two data sheets then one for each day of the month (sheets
1,2,3 etc)).
- In the source file I may have multiple OR single entries to copy for one
day. If
2/3/4 events happen in one day they both need transferred to the Summary
file. This means that maybe on Jan 1 i need to copy row 12 but on Jan 2 i
need
to copy rows 12,13&14. In days with one event rows 13 and 14 will be empty.
- The last point leads onto another complication in the Summary. The entries
are recorded per day, which i'd though of just having a vertical list of
dates - this
won't work as I dont know of how times i need to repeat each day.

In one day there will only be a few entries and past entries will not be
overwritten. Is it possible to have the following sequence?

- the user opens the folder and fills in the entries for the day
(incidentally the events which happened on day x are recorded in the file on
day x+1, as in something that happens on wed is recorded on thurs).
- when the source file is closed the macro runs automatically. The macro:

Checks if there is any data in rows 12,13,14, if there is it copies the
data, if not it closes the open file. In the case where data exists it then
opens the Summary file, pastes the data into the next xx empty rows,
(depending on how much there is to be copied. For the rows that it has copied
it then copy pastes the date from the source file/sheet/cell C3 to the
Summary/sheet (a,b,c)/cell Axx.

Maybe there is a simpler way to manage it, however I am stuck with the file
formats etc as they are.

Is this possible?

Thanks a lot for your help
LiAD

 

[Joel]

This can easily be done. It is not very complicated but I need to answers

1) Since you may not run the macro every day (like weekends) you would want
someplace to keep track of the last date that it was run so the macro will
run through a series of dates. A message box can be opened to list the first
data and the last date will be Today's date. Or anding a cell to the summary
workbook where the last date the macro was run. I assume the Summary sheet
is for only one year and doesn't contain multiple years.

2) You ay the summary workbook you need to write to 5 sheets (a,b,c,d,e) but
I don't see a description of what data get written to each sheet.

 

[Sam Wilson]

Sub SummariseYear()

Application.DisplayAlerts = False

Dim xwb As Workbook
Dim xws As Worksheet
Set xwb = ActiveWorkbook
Set xws = xwb.Worksheets("a")

Dim wb As Workbook
Dim ws As Worksheet

Dim sPath As String
Dim sFile(11) As String

sFile(0) = "Jan.xls"
sFile(1) = "Feb.xls"
sFile(2) = "Mar.xls"
sFile(3) = "Apr.xls"
sFile(4) = "May.xls"
sFile(5) = "Jun.xls"
sFile(6) = "Jul.xls"
sFile(7) = "Aug.xls"
sFile(8) = "Sep.xls"
sFile(9) = "Oct.xls"
sFile(10) = "Nov.xls"
sFile(11) = "Dec.xls"

Dim i As Integer
Dim k As Integer

sPath = "C:\path\"

For i = 1 To 12
Set wb = Workbooks.Open(sPath & sFile(i))
For Each ws In wb.Worksheets
If Not xws.Index < 3 Then
For k = 0 To 2
If Not IsEmpty(ws.Range("D12").Offset(k, 0)) Then
xws.Range("f2").Offset(j, 0).Value =
ws.Range("d12").Offset(k, 0).Value
xws.Range("g2").Offset(j, 0).Value =
ws.Range("e12").Offset(k, 0).Value
xws.Range("d2").Offset(j, 0).Value =
ws.Range("m12").Offset(k, 0).Value
j = j + 1
End If
Next k
End If
Next ws
wb.Close
Next i

Application.DisplayAlerts = True

End Sub