G
Guest
How do I modify the code below to stop running on each row with data until it
hits a blank row? I want to use a command button to execute for one row of
data only. This is a follow up to a post from Dave Petersen (he wrote the
code below) last week. Thanks all!
Private Sub Merge_Click()
Dim fWks As Worksheet
Dim tWks As Worksheet
Dim fCol As Variant
Dim tAddr As Variant
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim iCtr As Long
fCol = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "k", "l", "m",
"o", "p")
tAddr = Array("a1", "b1", "d12", "e13", _
"c5", "a18", "a15", "c12", "f3", "f4", _
"f17", "g9", "e1", "e2")
If UBound(fCol) <> UBound(tAddr) Then
MsgBox "Design error--Not same number of columns/cells)"
End If
Set fWks = Worksheets("Entry")
Set tWks = Worksheets("Form")
With fWks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = FirstRow To LastRow
If IsEmpty(.Cells(iRow, "A")) Then
'skip this row
Else
For iCtr = LBound(fCol) To UBound(fCol)
tWks.Range(tAddr(iCtr)).Value _
= .Cells(iRow, fCol(iCtr)).Value
Next iCtr
tWks.PrintOut preview:=True
End If
Next iRow
End With
End Sub
hits a blank row? I want to use a command button to execute for one row of
data only. This is a follow up to a post from Dave Petersen (he wrote the
code below) last week. Thanks all!
Private Sub Merge_Click()
Dim fWks As Worksheet
Dim tWks As Worksheet
Dim fCol As Variant
Dim tAddr As Variant
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim iCtr As Long
fCol = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "k", "l", "m",
"o", "p")
tAddr = Array("a1", "b1", "d12", "e13", _
"c5", "a18", "a15", "c12", "f3", "f4", _
"f17", "g9", "e1", "e2")
If UBound(fCol) <> UBound(tAddr) Then
MsgBox "Design error--Not same number of columns/cells)"
End If
Set fWks = Worksheets("Entry")
Set tWks = Worksheets("Form")
With fWks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = FirstRow To LastRow
If IsEmpty(.Cells(iRow, "A")) Then
'skip this row
Else
For iCtr = LBound(fCol) To UBound(fCol)
tWks.Range(tAddr(iCtr)).Value _
= .Cells(iRow, fCol(iCtr)).Value
Next iCtr
tWks.PrintOut preview:=True
End If
Next iRow
End With
End Sub