mailing labels. . .but first, name list
 

I want to create mailing lists from the name, address, city state zip info
on each sheet in the workbook. But I'm stumped on how to copy the range from
B1:B3 to another sheet ("names") and have the info run from A2:C2.

So far I'm able to have the data print only in the A column and for the code
I have:

Private Sub CommandButton2_Click()

Dim iSheet As Integer, iBefore As Integer
Dim sSheetName As String, sActiveCell As String
Dim cRow As Long, cCol As Long, cSht As Integer
Dim lastcell
Dim qSht As String
Dim mg As String
Dim rg As Range
Dim CRLF As String
Dim Name As String
Dim Address As String
Dim CityStZ As String
Dim Reply As Variant
With Range("A1:F40").Font.Size = 20
End With
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
cRow = 1
cCol = 1
sSheetName = UCase(ActiveSheet.Name)
sActiveCell = UCase(ActiveCell.Value)
'mg = ""
'CRLF = Chr(10) 'Actually just CR
Range("A1").Select
For cSht = 1 To ActiveWorkbook.Sheets.Count
' cCol = cCol + 0
' cRow = cRow + 1
' MsgBox Range(cCol, cRow)
qSht = Application.Substitute(Sheets(cSht).Name, """", """""")
Sheets("names").Cells(cRow + cSht, cCol).Formula =
ActiveSheet.Range("B1B3")
'_
' "=hyperlink(""[" & ActiveWorkbook.Name _
' & "]'" & qSht & "'!A1"",""" & qSht & """)"

Name=UCase(ActiveSheet.Range("B1"))
Address = UCase(ActiveSheet.Range("B2"))
CityStZ = UCase(ActiveSheet.Range("B3"))
'MsgBox Address
On Error Resume Next
If TypeName(Sheets(cSht)) < "Worksheet" Then GoTo byp7
Set lastcell = Sheets(cSht).Cells.SpecialCells(xlLastCell)
byp7: 'xxx
On Error GoTo 0
Next cSht

Application.ScreenUpdating = True
Application.ScreenUpdating = False


End Sub

Any suggestions?

mailing labels. . .but first, name list
 

First, I think it would be easier to create a mailing list in excel and use
MSWord to create the labels.

Here are a couple of links about using mail merge:
http://www.mvps.org/dmcritchie/excel/mailmerg.htm
http://www.mvps.org/word/FAQs/MailMerge

The first is from David McRitchie and the second is by Beth Melton and Dave
Rado.

Then you could just copy from each sheet and paste normally to a consolidation
sheet.

But...

I'm not sure what you're doing, but you could record a macro when you do a
copy|paste special|Transpose to go from A2:C2 to B1:B3.

You may want to post more details about what you're doing...

Weaver Land wrote:

I want to create mailing lists from the name, address, city state zip info
on each sheet in the workbook. But I'm stumped on how to copy the range from
B1:B3 to another sheet ("names") and have the info run from A2:C2.

So far I'm able to have the data print only in the A column and for the code
I have:

Private Sub CommandButton2_Click()

Dim iSheet As Integer, iBefore As Integer
Dim sSheetName As String, sActiveCell As String
Dim cRow As Long, cCol As Long, cSht As Integer
Dim lastcell
Dim qSht As String
Dim mg As String
Dim rg As Range
Dim CRLF As String
Dim Name As String
Dim Address As String
Dim CityStZ As String
Dim Reply As Variant
With Range("A1:F40").Font.Size = 20
End With
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
cRow = 1
cCol = 1
sSheetName = UCase(ActiveSheet.Name)
sActiveCell = UCase(ActiveCell.Value)
'mg = ""
'CRLF = Chr(10) 'Actually just CR
Range("A1").Select
For cSht = 1 To ActiveWorkbook.Sheets.Count
' cCol = cCol + 0
' cRow = cRow + 1
' MsgBox Range(cCol, cRow)
qSht = Application.Substitute(Sheets(cSht).Name, """", """""")
Sheets("names").Cells(cRow + cSht, cCol).Formula =
ActiveSheet.Range("B1B3")
'_
' "=hyperlink(""[" & ActiveWorkbook.Name _
' & "]'" & qSht & "'!A1"",""" & qSht & """)"

Name=UCase(ActiveSheet.Range("B1"))
Address = UCase(ActiveSheet.Range("B2"))
CityStZ = UCase(ActiveSheet.Range("B3"))
'MsgBox Address
On Error Resume Next
If TypeName(Sheets(cSht)) < "Worksheet" Then GoTo byp7
Set lastcell = Sheets(cSht).Cells.SpecialCells(xlLastCell)
byp7: 'xxx
On Error GoTo 0
Next cSht

Application.ScreenUpdating = True
Application.ScreenUpdating = False

End Sub

Any suggestions?

--

Dave Peterson