how do i skip blank rows? sheet 1 has d10=alex, d17=ben, d24=carlo, i
transferred them to sheet 2,
B4 alex 1
<blank
<blank
B11 ben 2
<blank
<blank
B18 carlo 3

what do i need to add in my code?
Sub Macro1()
Application.ScreenUpdating = False

rowref = Sheet6.Cells(2, 2)
Sheets("Dept Summary").Select
a = 3
For X = 10 To rowref Step 1
a = a + 1
Name = Sheet2.Cells(X, 4)
Sheets("PHTemp").Select
Cells(a, 2) = Name
Next X

Sheets("Dept Summary").Select
destcol = 3
For rowtocopy = 10 To rowref Step 1
destcol = destcol + 1
Range(Cells(rowtocopy, 29), Cells(rowtocopy, 35)).Select
Selection.Copy
Sheets("PHTemp").Select
Cells(destcol, 5).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False

Sheets("Dept Summary").Select
Next rowtocopy
Sheets("PHTemp").Select

Application.ScreenUpdating = True
End Sub

thank you mauro! it worked!

"Mauro Gamberini" wrote:

Public Sub m()

On Error GoTo ErrorRow

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim lLastRow As Long
Dim rng As Range

With Application
.ScreenUpdating = False
.Calculation = xlManual
.StatusBar = "Runs: Sub m()"
End With

Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")

With sh1
lLastRow = _
.Range("D" & Rows.Count).End(xlUp).Row
Set rng = _
.Range("D2:D" & _
lLastRow).SpecialCells( _
xlCellTypeConstants)
rng.Copy sh2.Range("B2")
End With

ExitRow:
Set rng = Nothing
Set sh2 = Nothing
Set sh1 = Nothing
With Application
.ScreenUpdating = True
.Calculation = xlAutomatic
.StatusBar = ""
End With
Exit Sub

ErrorRow:
MsgBox Err.Number & vbNewLine & Err.Description
Resume ExitRow

End Sub


--
---------------------------
Mauro Gamberini
http://www.riolab.org/
"louie" ha scritto nel messaggio
...
how do i skip blank rows? sheet 1 has d10=alex, d17=ben, d24=carlo, i
transferred them to sheet 2,