Copy and pastespecial without formulas

[Steven Cheng]

I have the following code which looks into a named range
(emaillist) and copies and pastes certain ranges (defined
in this emaillist range) to another workbook (which I will
later email out. However, the copying and pasting should
only be by value and format. I have included the code in
but it still isn't working for some reason. The ranges
that it is pulling from are noncontinguous hence why I
have the range names listed in the emaillist. Everything
works fine up to the adding and copy but not the
pastespecial feature for some reason. Can anyone help
me...I am so close but yet so far.

Sub Reporting()
Dim a, b, c As String
Dim email As Range
Dim r, y As Integer
Dim wkb, cwkb As Workbook
'
' Macro2 Macro
' Macro recorded 07/25/2003 by Steven Cheng
'

'
a = "Period " & Format(Worksheets("Hotel_Info").Range
("Period").Value, "00")
a = a & ", Day " & Format(Worksheets
("Hotel_Info").Range("Current_day").Value, "00")
a = a & " " & Format(Worksheets("Hotel_Info").Range
("Year").Value, "0000")
a = a & " - " & Format(Worksheets("Hotel_info").Range
("Report_Date").Value, "mm/dd/yyyy")

Set email = Worksheets("Hotel_info").Range("emaillist")

' cwkb = ActiveWorkbook
With Worksheets("Report")
For r = 1 To email.Rows.Count
b = .Range("Titles").Address & "," & .Range
("Summary_lbr").Address

For y = 1 To email.Columns.Count
If Trim(email.Cells(r, y + 1).Text) <> ""
Then
b = b & "," & .Range(email.Cells(r, y
+ 1).Text).Address
End If
Next
.Range(b).Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlValue
Selection.PasteSpecial Paste:=xlFormats
Next
End With
' .SendMail Recipients:="(e-mail address removed)"

End Sub

 

[Patrick Molloy]

first, strighten this out.

Dim a, b, c As String
Dim email As Range
Dim r, y As Integer
Dim wkb, cwkb As Workbook

should be

Dim a As String, b As String, c As String
Dim email As Range
Dim r As Integer, y As Integer
Dim wkb As Workbook, cwkb As Workbook

with VB, not explicitly decalring the type defaults to Variant, so in yours,
a,b,y and wkb are variant.

as for the rest, well, some example data may help us.

 

[Steven Cheng]

Patrick;

Thanks for that tip. I know I do some fairly non-
conventional coding...but I am self-taught so nothing is
ever proper.

I have tried to remove the first for/next loop which
counts the rows and run it for a single row within my
email list(my email list is setup in a table where the
first column is the email address and subsequent columns
contain the range names of the reports that the email
address would be privy to). It works fine as I replace the
variable r with a numeric value and the pastespecial by
value and format works fine.

I have documented my coding so as to better illustrate
what is going on and hopefully will make more sense.

Sub Reporting()
Dim a As String, b As String
Dim email As Range
Dim r As Integer, c As Integer


' creates the subject line reference for the email
a = "Period " & Format(Worksheets("Hotel_Info").Range
("Period").Value, "00")
a = a & ", Day " & Format(Worksheets
("Hotel_Info").Range("Current_day").Value, "00")
a = a & " " & Format(Worksheets("Hotel_Info").Range
("Year").Value, "0000")
a = a & " - " & Format(Worksheets("Hotel_info").Range
("Report_Date").Value, "mm/dd/yyyy")

' transfers the email list to a range variable

Set email = Worksheets("Hotel_info").Range("emaillist")


With Worksheets("Report")

' loops r until all emails are setup. Email list setup
in rows.
For r = 1 To email.Rows.Count

' All individuals on the email list get the summary
reports and thus b variable will
' hold all addresses of the print tiles and Summary
report
b = .Range("Titles").Address & "," & .Range
("Summary_lbr").Address

' Email list has a certain reports to be issued to
individuals and are setup in columns
For c = 1 To email.Columns.Count

' tests to see if there is a blank cell. If there is
no value, there there are no other
' reports. Otherwise, the address of the named ranges
are listed in columns beside the
' email addresses. b will hold the addresses of the
non-continguous ranges until there are
' other blank columns

If Trim(email.Cells(r, c + 1).Text) <> ""
Then
b = b & "," & .Range(email.Cells(r, c
+ 1).Text).Address
End If
Next
' after there are no other addresses/columns to go
through, we want to copy the ranges
.Range(b).Copy

' creates the blank workbook
Workbooks.Add

' newly created blank workbook will be the active
workbook by defaul and sheet1 will be the
' activeworksheet by default. We will paste the
ranges of b to this blank workbook only by value
' and format.
Selection.PasteSpecial Paste:=xlValue,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Next
End With
' .SendMail Recipients:="(e-mail address removed)"

End Sub