Copy row from list and print

[Nigel]

I have a mailing list in excel with the first row being headers. I need to
copy the list one row at a time, transpose the row and paste into a new sheet
in col B which already has the headers vertically in col A. I then need to
print this page, delete the data that has just been pasted and start again
with the next row in the mailing list.
My attempt at performing this task is below (it does'nt work) can anybody
help.

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 04/04/2008 by nigel
'

'
Worksheets("Mailing_List").Activate
Range("A2").Activate
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _
tbl.Columns.Count).Select
For Each rw In Worksheets("Mailing_List").CurrentRegion.Copy
Sheets("Directory").Range("B3").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone,
SkipBlanks:=False _
, Transpose:=True
ActiveSheet.PrintOut
Range("B3:B38").Clear
Next
End Sub

 

[cht13er]

I have a mailing list in excel with the first row being headers. I need to
copy the list one row at a time, transpose the row and paste into a new sheet
in col B which already has the headers vertically in col A. I then need to
print this page, delete the data that has just been pasted and start again
with the next row in the mailing list.
My attempt at performing this task is below (it does'nt work) can anybody
help.

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 04/04/2008 by nigel
'

'
Worksheets("Mailing_List").Activate
Range("A2").Activate
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _
tbl.Columns.Count).Select
For Each rw In Worksheets("Mailing_List").CurrentRegion.Copy
Sheets("Directory").Range("B3").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone,
SkipBlanks:=False _
, Transpose:=True
ActiveSheet.PrintOut
Range("B3:B38").Clear
Next
End Sub

See if this helps:

Public Sub doit()

'Copy
Sheets("Mailing List").Activate
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select ' I think you
don't want this row
Selection.Copy

'Paste
Sheets("Directory").Activate
Range("B1").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone,
SkipBlanks:=False _
, Transpose:=True
Application.CutCopyMode = False

'Print
ActiveWorkbook.PrintOut
End Sub

You'll want to do a few things: check the cells that are being
selected, and look at the row with the comment above ... and then of
course add a loop - I'll let you figure that out for yourself?

(Something like Do Until ActiveCell = ""
....'copy
....'paste
...'print
ActiveCell.Offset(1,0).Select
Loop

HTH

Chris

 

[Joel]

try this

ub Macro1()
'
' Macro1 Macro
' Macro recorded 04/04/2008 by nigel
'

'
Worksheets("Mailing_List").Activate
Range("A2").Activate
Set tbl = ActiveCell.CurrentRegion

tbl.Resize(tbl.Rows.Count, _
tbl.Columns.Count).Select

For rw = tbl.Row To tbl.End(xlDown).Row
Worksheets("Mailing_List").Rows(rw).EntireRow.Copy
With Sheets("Directory")
.Range("B3").PasteSpecial _
Paste:=xlAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=True
'.PrintOut
.Range("B3:B38").Clear
End With
Next
End Sub

 

[Nigel]

Excellent, thanks Joel

try this

ub Macro1()
'
' Macro1 Macro
' Macro recorded 04/04/2008 by nigel
'

'
Worksheets("Mailing_List").Activate
Range("A2").Activate
Set tbl = ActiveCell.CurrentRegion

tbl.Resize(tbl.Rows.Count, _
tbl.Columns.Count).Select

For rw = tbl.Row To tbl.End(xlDown).Row
Worksheets("Mailing_List").Rows(rw).EntireRow.Copy
With Sheets("Directory")
.Range("B3").PasteSpecial _
Paste:=xlAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=True
'.PrintOut
.Range("B3:B38").Clear
End With
Next
End Sub