Hi Rick,

If I understand you correctly, then you want range A3:G39 copied over
to calendar summary without overwriting the previous month. Try
something like this:

'====================================
'rngFrom: the range to be copied
'clTo: the upper-left-corner cell of the summary range
'across: the number of columns across
'month: the month to be copied

Private Sub copyToSummary(ByVal rngFrom As Excel.Range, ByVal clTo As
Excel.Range, across As Integer, ByVal month As Integer)

Dim cols As Integer, rows As Integer, a As Integer, d As Integer

cols = rngFrom.Columns.Count
rows = rngFrom.rows.Count

a = ((month - 1) Mod across) * cols
d = (Fix((month - 1) / across)) * rows

Set clTo = clTo.Offset(d, a)

rngFrom.Copy clTo

End Sub
'====================================

You would then call it like so:

copyToSummary Worksheets("CRANE WT SUMMARY").Range("A3:G39"),
Worksheets("CALENDER SUMMARY").Range("B3"), 3, Month(rng1)

Regards,
Steve

tracks via OfficeKB.com schrieb:

I have been able to put together the code as follows with much help and
patience from the people of this site, alittle additional assistance would be
greatly appreciated the code works well until the if statement the then part.
the range("A3:G9") is filled over the period of one month, when the month
changes to the next month (ie the ifstatement) the range ("A3:G39") is
copied to Worksheet("Calender Summary"). the first range on that sheet is (B3:
H39) the next month range is dimensions
7columns by 37 rows. the layout for the mnths on worksheet(Calender Summary)
is three months across by 4 down. i tried using offset and was unsuer how set
intial variables

Worksheets("CRANE WT SUMMARY").Range("A3:G39").Select
Selection.Copy _
Worksheets("CALENDER SUMMARY").Range("B3:H39").Offset(0, 0)

the range blocks are B3:H39,J3:P39,R2:X39,B43:H80,J43:P80,R43:X80 etc


b CO()
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range

Set rng1 = Worksheets("DAILY CRANE INFO").Range("I7")

With Worksheets("CRANE WT SUMMARY")
Set rng2 = .Cells(.Rows.Count, 1).End(xlUp)

End With

If Month(rng1) Month(rng2) Then
Worksheets("CRANE WT SUMMARY").Range("A3:G39").Select
Selection.Copy _
Worksheets("CALENDER SUMMARY").Range("B3:H39").Offset(0, 0)

Worksheets("CRANE WT SUMMARY").Range("A7:G31").Select
Selection.ClearContents

Call Sheet2.TEST

Else: Call Sheet2.TEST

End If

End Sub


Sub TEST()
Dim DestCell As Range

With Worksheets("crane wt summary")
Set DestCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With

With Worksheets("daily crane info")
.Range("I7").Copy
DestCell.PasteSpecial Paste:=xlPasteValues


.Range("AA15:AF15").Copy
DestCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues

End With

Worksheets("DAILY PRODUCTION").Select
ActiveSheet.Range("C9:D13,C15:D17,C19:D36,C39:D44, F9:G13,F15:G17,
F19:G36,F38:G44,E9:E13,E15:E17,E20:E30,E38:E44").S elect
Selection.ClearContents


End Sub


I thank you for your time and help

Rick Mason(TRACKS)

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200611/1