skip blank rows

L

louie

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
 
M

Mauro Gamberini

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
 
L

louie

thank you mauro! it worked!

Mauro Gamberini said:
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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top