VBA Error 1004 on second time running the code

Status
Not open for further replies.
J

jondavis1987

Active Member
Joined
Dec 31, 2015
Messages
443
Office Version
  1. 2019
Platform
  1. Windows
VBA Code: 
' Copy Samples data from source workbook to destination workbook

srcWB.Sheets("A").Range("G20").Copy

destWB.Sheets("Samples").Range("A" & lastRow).PasteSpecial xlPasteValues

I have a template that I use to enter reports on different materials. The material is selected from a data validation list in cell B6. A bunch of index/match formulas generate information based on the dropdown selection. I have to do two or three of these reports per day and I typically do them all at the end of the day. After filling each one out I run the vba. The first time running the vba it runs perfectly. Without changing any of the formatting I'll select a different dropdown material and enter the information on it. When I try to run the vba the second time the following error pops up. "Error Runtime 1004 You can’t paste this here because the Copy area and paste area aren’t the same size. Select just one cell in the area or an area that’s the same size, and try pasting again." The above code at the bottom of it is where the debug highlights. The code below is the full code. Since it runs correctly on the first run I can't imagine it's actually a formatting error. If I close out of the program and enter the same information the vba code will run flawlessly again.

VBA Code: 
Option Explicit

Sub Open_Workbook()

    Dim srcWB As Workbook
    Dim destWB As Workbook
    Dim fName As String
    Dim lastRow As Long
   
'   Capture current workbook as source workbook
    Set srcWB = Workbooks("Superpaves")

'   Open destination workbook and capture it as destination workbook
    Workbooks.Open "C:\Users\" & Environ("username") & "\Dropbox\Quality Control\Asphalt\Misc\Yearly HMA Charts.xlsx"
    Set destWB = Workbooks("Yearly HMA Charts")
   


'   Unhide_Multiple_Sheets()
    destWB.Sheets("Samples").Visible = True
    destWB.Sheets("Sieves").Visible = True

'   Find last row of Sieve data in destination workbook
    lastRow = destWB.Sheets("Sieves").Cells(Rows.Count, "G").End(xlUp).Row + 1
   
'   Copy Sieve data from source workbook to destination workbook
    srcWB.Sheets("A").Range("G20").Copy
    destWB.Sheets("Sieves").Range("A" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H20").Copy
    destWB.Sheets("Sieves").Range("B" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G3").Copy
    destWB.Sheets("Sieves").Range("C" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G5").Copy
    destWB.Sheets("Sieves").Range("D" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("B6").Copy
    destWB.Sheets("Sieves").Range("E" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("A10:A21").Copy
    destWB.Sheets("Sieves").Range("F" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("D10:D21").Copy
    destWB.Sheets("Sieves").Range("G" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G21:G32").Copy
    destWB.Sheets("Sieves").Range("H" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H21:H32").Copy
    destWB.Sheets("Sieves").Range("I" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("D22").Copy
    destWB.Sheets("Sieves").Range("J" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G47").Copy
    destWB.Sheets("Sieves").Range("K" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H47").Copy
    destWB.Sheets("Sieves").Range("L" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("C53").Copy
    destWB.Sheets("Sieves").Range("M" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G48").Copy
    destWB.Sheets("Sieves").Range("N" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H48").Copy
    destWB.Sheets("Sieves").Range("O" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
   
'   Find last row of Samples data in desitnation workbook
    lastRow = destWB.Sheets("Samples").Cells(Rows.Count, "A").End(xlUp).Row + 1
   
'   Copy Samples data from source workbook to destination workbook
    srcWB.Sheets("A").Range("G20").Copy
    destWB.Sheets("Samples").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H20").Copy
    destWB.Sheets("Samples").Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G3").Copy
    destWB.Sheets("Samples").Range("C" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G5").Copy
    destWB.Sheets("Samples").Range("D" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("B6").Copy
    destWB.Sheets("Samples").Range("E" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("Sheet2").Range("D31").Copy
    destWB.Sheets("Samples").Range("F" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("Sheet2").Range("E31").Copy
    destWB.Sheets("Samples").Range("G" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("Sheet2").Range("F31").Copy
    destWB.Sheets("Samples").Range("H" & lastRow).PasteSpecial xlPasteValues

'   Hide_Multiple_Sheets()
    destWB.Sheets("Samples").Visible = False
    destWB.Sheets("Sieves").Visible = False
   
'   Save changes and close destination workbook
    destWB.Close SaveChanges:=True

    Dim srcWB1 As Workbook
    Dim destWB1 As Workbook
    Dim fName1 As String
    Dim lastRows As Long
    Dim destName As String
    Dim wsName As String

'   Capture current workbook as source workbook
    Set srcWB = Workbooks("Superpaves")

'   Set the name of the destination workbook
    destName = srcWB.Sheets("A").Range("F8").Text

'   Set the name of the destination worksheet
    wsName = srcWB.Sheets("A").Range("B6").Text

'   Open destination workbook and capture it as destination workbook
    Workbooks.Open "C:\Users\" & Environ("username") & "\Dropbox\Quality Control\Asphalt\Mold Heights\" & destName & ".xlsx"
    Set destWB = Workbooks(destName)
   
'   Error Route
    On Error GoTo ErrHandler:
    Worksheets(wsName).Activate

'   Find last row of data in desired worksheet of destination workbook
    lastRow = destWB.Sheets(wsName).Cells(Rows.Count, "A").End(xlUp).Row + 1

'   Copy Mold Heights data from source workbook to destination workbook
    srcWB.Sheets("A").Range("G3").Copy
    destWB.Sheets(wsName).Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("E46").Copy
    destWB.Sheets(wsName).Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("D22").Copy
    destWB.Sheets(wsName).Range("C" & lastRow).PasteSpecial xlPasteValues

'   Save changes and close destination workbook
    destWB.Close SaveChanges:=True

'   Export source workbook to PDF
    With srcWB
        fName = srcWB.Sheets("A").Range("A!F19").Value
                Sheets(Array("A", "Sheet2")).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\Users\" & Environ("username") & "\Dropbox\Quality Control\Asphalt\Asphalt Reports\" & fName, _
        openafterpublish:=True, ignoreprintareas:=False
    End With


Exit Sub

ErrHandler:
    If Err.Number = 9 Then
        ' sheet does not exist, so create it
        Worksheets.Add.Name = wsName
        destWB.Sheets(wsName).Range("A1").Value = "Date"
        destWB.Sheets(wsName).Range("B1").Value = "Mold Height"
        destWB.Sheets(wsName).Range("C1").Value = "AC"
         destWB.Sheets(wsName).Range("F2").Value = "Avg Height"
          destWB.Sheets(wsName).Range("F3").Value = "Avg AC"
           destWB.Sheets(wsName).Range("G2").Value = "=Average(B:B)"
            destWB.Sheets(wsName).Range("G3").Value = "=Average(C:C)"
            destWB.Sheets(wsName).Range("A1", "A5000").NumberFormat = "mm/dd/yyyy"
            destWB.Sheets(wsName).Range("B1", "B5000").NumberFormat = "0.0"
            destWB.Sheets(wsName).Range("C1", "C5000").NumberFormat = "0.00"

'   Borders
             Range("F2:G3").Select
    Range("G3").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        
        
ActiveSheet.ListObjects.Add(xlSrcRange, destWB.Sheets(wsName).Range("$A$1:$C$1"), , xlYes).Name = wsName
       
        '   Find last row of data in desired worksheet of destination workbook
    lastRow = destWB.Sheets(wsName).Cells(Rows.Count, "A").End(xlUp).Row

'   Copy Mold Heights data from source workbook to destination workbook
    srcWB.Sheets("A").Range("G3").Copy
    destWB.Sheets(wsName).Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("E46").Copy
    destWB.Sheets(wsName).Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("D22").Copy
    destWB.Sheets(wsName).Range("C" & lastRow).PasteSpecial xlPasteValues
   
'   Autofit Columns
    destWB.Sheets(wsName).Columns("A:G").AutoFit
   
'   Save changes and close destination workbook
    destWB.Close SaveChanges:=True

'   Export source workbook to PDF

    With srcWB
        fName = srcWB.Sheets("A").Range("A!F19").Value
       
       
           Sheets(Array("A", "Sheet2")).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\Users\" & Environ("username") & "\Dropbox\Quality Control\Asphalt\Asphalt Reports\" & fName, _
        openafterpublish:=True, ignoreprintareas:=False



    End With


       End If
  
End Sub
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Sort by date Sort by votes
Duplicate - please don't repost the same question. Thread closed.
 
Upvote 0
Status
Not open for further replies.

Similar threads

K
  • Solved
formating question
Replies
3
Views
299
Micron
M
L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
576
RoryA
RoryA
P
  • Question Question
Issue with button not running in spread sheet only in test mode
Replies
1
Views
360
6StringJazzer
6StringJazzer
K
  • Solved
create a button that do actions
2 3
Replies
22
Views
1K
kerm007
K
J
  • Solved
VBA Keeps Skipping a Paste
2
Replies
11
Views
1K
jondavis1987
J

Forum statistics

Threads
1,223,248
Messages
6,171,027
Members
452,374
Latest member
keccles

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top