VBA Separate monthly data into weekly data

[Vokas]

Hello,

I'm thinking about this all day long and didn't come to conclusion how can i solve it. Hope you can help me with this.

What i need is a macro to separate (copy) montly data from one sheet into weekly data, creating new sheets for every week.

For example, I have a file with data from 02.05.2013 to 27.05.2013. I need macro to copy whole raws from 27.05.2013 till 21.05.2013. to another (new) sheet (called Week1) and so on (from 20.05. to 14.05 to Week2 sheet, etc...) taking in account cell A1 as starting date.

The dates i have in "montly" sheet (i call it monthly but it can contain data for 2-3 months) are in column A (descending order, containing only dates), and macro must take the first cell as a reference cell. (e.g. if A1 is 12.08.2013, it will start to separate data from that date). The last week will usually not be full week or it can contain only 1 day but that's ok.

Hope i explained it well.

Any thoughts? Maybe i'm missing somthing easy here.

Thanks in advance.

 

[rollis13]

Cross-Post:
VBA Separate monthly data into weekly data
VBA Separate monthly data into weekly data

 

[Vokas]

Solved on other forum.

Option Explicit
Sub WeekOut(): Dim n As Integer, wm As Worksheet, ww As Worksheet
Dim w As Long, r As Long, i As Long, D As Range, Ref As Integer
Set wm = ActiveSheet: r = wm.Range("A" & Rows.Count).End(xlUp).Row: i = r
DefBlock: If r = 0 Then Exit Sub
Ref = Day(wm.Range("A" & r))
Do Until Day(CDate(wm.Range("A" & i - 1))) = Ref + 7: i = i - 1
                If i = 1 Then Exit Do
                                        Loop: n = n + 1
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Week " & n
Set ww = ActiveSheet: wm.Range("A" & i & ":A" & r).EntireRow.Copy ww.Range("A1")
r = i - 1: i = r: GoTo DefBlock
End Sub

 

[rollis13]

Thanks for the feedback.