I believe this will cover everything. If not, post back.
Your code indicated that Column D was tested for a value
greater than zero and if found, copy to a second sheet with
the objective being to copy columns A thru F of that row to
the second sheet and to remove any cell coloring if it existed.
The last part of your code appeared to test for any entries that
might have been pasted to row two of the second sheet and if found
insert a row to move the data downward. This code attempts to
cover all of those items. Good luck.


Dim sh1 As Worksheet, sh2 As Worksheet
Dim rng As Range, cRng As Range, lr As Long

Set sh1 = Sheets("CARBWORKSHEET")
Set sh2 = Sheets("DailyRecord")
Set rng = sh1.Range("D3:D17")

For Each c In rng
If c.Value 0 Then
Set cRng = sh1.Range("A" &c.Row & ":F" & c.Row)
lr = sh2.Cells(Rows.Count, 1).End(xlUp).Row
If lr < 2 Then lr = 2
cRng.Copy sh2.Range("A" & lr + 1)
sh2.Range("A" & lr + 1).EntireRow.Interior.Pattern = xlNone
End If
Next

P.S. The flicker and flash should also be gone.




"BillR" wrote in message
...
Here is the code. It works, but I have been unable to select more than one
column at a time. This causes much flicker on the screen and looks like I
have absolutely no idea what I am doing. I think that may be right.

Sheets("CARBWORKSHEET").Select
counter = 3
For counter = 3 To 17
' Sheets("CARBWORKSHEET").Select
If Worksheets("CARBWORKSHEET").Cells(counter, 4).Value 0 Then
For col = 1 To 6
Sheets("CARBWORKSHEET").Select
Set curCell = Worksheets("CARBWORKSHEET").Cells(counter, col)
curCell.Select
Selection.Copy
Sheets("DailyRecord").Select
Set newcell = Worksheets("DailyRecord").Cells(2, col)
newcell.Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats,
Operation:=xlNone, SkipBlanks:=True, Transpose:=False
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
End With
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next col
Else
col = 1
End If
Set skipcell = Worksheets("DailyRecord").Cells(2, 4)
If skipcell.Value 0 Then
Sheets("DailyRecord").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Selection.ClearFormats
End If
Next counter

--
BillR


"JLGWhiz" wrote:

It would be helpful if you post the code you have so far. It helps to
fill
in the gaps in your narrative.


"BillR" wrote in message
...
I want to do something like this:
Select a sheet
for row=3 to 17
select cells A:F
copy the cells
Select A2 on another sheet
Paste what I copied.
Shift down 1 row
next row.

I have verything down pretty well except selecting A:F for each row as
it
comes up.
I would appreciate any help you can give me.
Thanks.
--
BillR


.