Divide Monthly Quantity into Weekly Quantity...

[jitendra.mistry]

Hello,

I am new into Macros world and I'm stuck with a problem:

What I managed to do by my self:
- Convert horizontal Monthly plan (Sheet1) into Vertical Monthly Plan (Sheet2) (plz see the attached file)

What I would like to:
- Convert this Vertical Monthly Plan into Veritcal Weekly Plan (Sheet3)

eg:
if plan is XYZ1 (Product) : 150 qty (Monthly production) Starting from 01/07/2010
XYZ2 (Product) : 150 qty (Monthly production) Starting from 01/08/2010

so after weekly macro run I should get something like in Sheet3 in respective column A:B:C (Horizontally)..

XYZ1 : 30 : 01/07/2010
XYZ1 : 30 : 08/07/2010
XYZ1 : 30 : 15/07/2010
XYZ1 : 30 : 22/07/2010
XYZ1 : 30 : 29/07/2010

Then XYZ2 should start by again at 01/08/2010...


XYZ2 : 30 : 01/08/2010
XYZ2 : 30 : 08/08/2010
XYZ2 : 30 : 15/08/2010
XYZ2 : 30 : 22/08/2010
XYZ2 : 30 : 29/08/2010

Macros Must consider the number of days in respective months

Also if possible please guide me to print this "Sheet3" only in Format *.CSV

Thanks alot guys
Cheers,
jitu

My Macros:

Public Sub TransformData()
' Copyright 1999 MrExcel.com
Sheets("Sheet2").Select
Range("A1").CurrentRegion.Clear
Range("A1").Value = "Reference"
' Sheets("Sheet1").Select
' Range("A2:B35").Copy Destination:=Sheets("Sheet2").Range("A2")
Sheets("Sheet2").Select
Range("B1").Value = "Month"
Range("C1").Value = "Qty"
Sheets("Sheet1").Select
FinalRow = Range("A16000").End(xlUp).Row
NextRow = 2
LastRow = FinalRow
' Loop through the data columns
For i = 2 To 13
ThisCol = Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", i, 1)
' Copy the left columns from sheet1 to sheet2
Range("A2:C" & FinalRow).Copy Destination:= _
Sheets("Sheet2").Range("A" & NextRow)
' Copy the header from ThisCol to column C
Range(ThisCol & "1").Copy Destination:= _
Sheets("Sheet2").Range("B" & NextRow & ":C" & LastRow)
' Copy the data for this quarter to column D
Range(ThisCol & "2:" & ThisCol & FinalRow).Copy _
Destination:=Sheets("Sheet2").Range("B" & NextRow)
NextRow = LastRow + 1
LastRow = NextRow + FinalRow - 2
Next i
Sheets("Sheet2").Select
With Application

.Calculation = xlCalculationManual

.ScreenUpdating = False

'We work backwards because we are deleting rows.

LastRow = Range("B" & Rows.Count).End(xlUp).Row
For j = LastRow + 2 To 1 Step -1
If Cells(j, "B").Value = 0 Or Cells(j, "C").Value = "" Then
Cells(j, "C").EntireRow.Delete
End If
Next j

.Calculation = xlCalculationAutomatic

.ScreenUpdating = True

End With



End Sub