1004 Error/pasting special values

[jcassel]

Hi all,

First time posting here so please bare with me. I have a piece of code I've cobbled together that had been working until I added some code to paste special values from several worksheets. When I run the code with the new piece, which I'll will highlight in red, I keep getting the "1004" error. The first sheet copies correctly and second sheet copies correctly, then seems to get hung up there. In total, I have four worksheets that I'm trying to copy/paste special values. Thanks for the help.


Private Sub CommandButton1_Click()

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

Worksheets(Array("Inv Summary", "Conf FRM Pool", "Conf ARM Pool", "HARP LTV GT 125")).Copy

Set Destwb = ActiveWorkbook

With Destwb
If Val(Application.Version) < 12 Then

FileExtStr = ".xls": FileFormatNum = -4143
Else

If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "You answered NO in the security dialog."
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With


Dim A As Byte
Dim B As Byte
Dim CT As Byte
Dim N As Byte

'{or Dim A, B, CT, N as Byte}

Let N = 4 '{number of worksheets to copy from}

Let A = 1 '{sheet position of first worksheet}
Let B = A + N - 1 '{sheet position of the last worksheet}

For CT = A To B

With Destwb.Sheets(CT).UsedRange
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select-------ERROR SEEMS TO OCCUR HERE
End With
Application.CutCopyMode = False

Next CT

TempFilePath = Environ$("temp") & "\"
TempFileName = "GT_Allocations" & " " _
& Format(Now, "mm-dd-yyyy")

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To =
.CC = ""
.BCC = ""
.Subject = "#######" & " " & Format(Now, "mm-dd-yyyy")
.Body = ""
.Attachments.Add Destwb.FullName
.Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With


Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

[Norie]

Just remove .Cells(1).Select, it's not needed.

[jcassel]

It works like a dream. I had a feeling that might do it.

Thank You