Thread: copy range
View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
joel[_973_] joel[_973_] is offline
external usenet poster
 
Posts: 1
Default copy range


Your instruction are a little vague. I took some guesses what you
wanted. Try this code. I can make somje simple changes if it is not
exactly correct



VBA Code:
--------------------


Sub MoveData()

NewRow = 1

With Sheets("Sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
NewCol = 2
AsteriskCount = 0
Header = .Range("A" & RowCount)
For ColIndex = 0 To 7
ColNumber = 3 * (ColIndex + 1)
Asterisk = .Cells(RowCount, ColIndex).Offset(0, 2)
Data = .Cells(RowCount, ColIndex).Offset(0, 2)
With Sheets("sheet2")
If Asterisk = "*" Then
AsteriskCount = AsteriskCount + 1
If AsteriskCount = 6 Then
NewCol = 2
AsteriskCount = 0
'total amounts on the line
Set SumRange = .Range("B" & NewRow & ":F" & NewRow)
Total = WorksheetFunction.Sum(SumRange)
.Range("A" & NewRow) = Header & "OZ/" & Total & "OZ.5"
NewRow = NewRow + 1
End If
.Cells(NewRow, NewCol) = Data
NewCol = NewCol + 1
End If
End With
Next ColIndex
If AsteriskCount 0 Then
Set SumRange = .Range("B" & NewRow & ":F" & NewRow)
Total = WorksheetFunction.Sum(SumRange)
.Range("A" & NewRow) = Header & "OZ/" & Total & "OZ." & _
AsteriskCount
NewRow = NewRow + 1
End If
Next RowCount
End With


End Sub

--------------------


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?u=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=200093

http://www.thecodecage.com/forumz