O
Optitron
I have rows of data on sheet2 that are put into sheet1 with the belo
program. What can I put in to enable me to select all the rows an
click the button to print a sheet1 for each row. Basically lik
printing an entire workbook with only 2 sheets and a button.
Option Explicit
Sub Cranial()
Dim prtWks As Worksheet
Dim actWks As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim iRow As Long
Set actWks = ActiveSheet
Set prtWks = Worksheets("Sheet1")
Set myRng = Intersect(Selection.EntireRow, actWks.Range("a:a"))
With prtWks
For Each myCell In myRng.Cells
iRow = myCell.Row
.Range("E7").Value = actWks.Cells(iRow, "A").Value
.Range("H7").Value = actWks.Cells(iRow, "B").Value
.Range("AY3").Value = actWks.Cells(iRow, "A").Value
.Range("BB3").Value = actWks.Cells(iRow, "B").Value
.Range("AC5").Value = actWks.Cells(iRow, "C").Value
.Range("AK5").Value = actWks.Cells(iRow, "D").Value
.Range("AM5").Value = actWks.Cells(iRow, "E").Value
Application.Calculate
Next myCel
program. What can I put in to enable me to select all the rows an
click the button to print a sheet1 for each row. Basically lik
printing an entire workbook with only 2 sheets and a button.
Option Explicit
Sub Cranial()
Dim prtWks As Worksheet
Dim actWks As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim iRow As Long
Set actWks = ActiveSheet
Set prtWks = Worksheets("Sheet1")
Set myRng = Intersect(Selection.EntireRow, actWks.Range("a:a"))
With prtWks
For Each myCell In myRng.Cells
iRow = myCell.Row
.Range("E7").Value = actWks.Cells(iRow, "A").Value
.Range("H7").Value = actWks.Cells(iRow, "B").Value
.Range("AY3").Value = actWks.Cells(iRow, "A").Value
.Range("BB3").Value = actWks.Cells(iRow, "B").Value
.Range("AC5").Value = actWks.Cells(iRow, "C").Value
.Range("AK5").Value = actWks.Cells(iRow, "D").Value
.Range("AM5").Value = actWks.Cells(iRow, "E").Value
Application.Calculate
Next myCel