why is copy and paste so tricky with vba?

ajm

Well-known Member
Joined
Feb 5, 2003
Messages
2,004
Office Version
  1. 365
Platform
  1. Windows
maybe its just me? anyhoo, i have a routine which opens another workbook, moves the data around and adds an autofilter. It should then copy the autofiltered range back to my source workbook.

Code:
With ESMwb.ActiveSheet.AutoFilter.Range
    .Offset(1, 0).Resize(.Rows.Count - 1).Copy
    Sourcewb.MainWS.Range("A" & LastRow + 1).PasteSpecial
    End With

I get "Run-time error 438: Object doesn't support this property or method" on the Sourcewb.MainWS... line

what is the correct syntax please?
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
you can put all the code to see your variables. or maybe

Code:
[/FONT][/COLOR]Sourcewb.MainWS.Range("A" & LastRow + 1).PasteSpecial xlpastevalues[COLOR=#3C4043][FONT=Roboto]
 
Upvote 0
adding xlpastevalues doesn't resolve the issue
 
Upvote 0
this works:
Code:
With ESMwb.ActiveSheet.AutoFilter.Range
.Offset(1, 0).Resize(.Rows.Count - 1).Copy Destination:=MainWS.Range("A" & CopyToRow)
    
End With
 
Last edited:
Upvote 0
Are you sure it's that line
try this one
Code:
Sourcewb.MainWS.Range("A" & LastRow + 1).PasteSpecial Paste:=xlPasteValues

Are sourcewb and MainWS declared corrrectly ??
As I always say...post all the code unless you are 110% sure it's a certain line....easier for us to test as well...:biggrin:
 
Upvote 0
If MainWS is a variable, try
Code:
 MainWS.Range("A" & LastRow + 1).PasteSpecial
 
Upvote 0
adding xlpastevalues doesn't resolve the issue

Of course it works.
But you did not put the code to check your variables.

This does not work
Code:
    Set Sourcewb = ActiveWorkbook
    Set MainWS = ActiveSheet
[COLOR=#ff0000]    Sourcewb.MainWS.Range("A" & LastRow + 1).PasteSpecial xlPasteValues[/COLOR]

But this does work
Code:
    Set Sourcewb = ActiveWorkbook
    Set MainWS = Sourcewb.ActiveSheet
[COLOR=#0000ff]    MainWS.Range("A" & LastRow + 1).PasteSpecial xlPasteValues[/COLOR]
 
Upvote 0
Thanks for your responses. Code is below. Gladly accept any suggestions for tidying it up: its a dogs breakfast at the moment and I am grabbing bits from here and there in my old files to get the job out.
Code:
Public strNewReviewFINAL As String

Sub CommandButton3_Click()
'update daily NRO data file to Master
    CreateObject("WScript.Shell").CurrentDirectory = ThisWorkbook.Path
    Dim UpdateFileName As Variant
    Dim Sourcewb As Workbook, ESMwb As Workbook
    Dim WS As Worksheet
    Dim MainWS As Worksheet
    Dim pos As Integer
    Dim strNewReviewExt, strNewReview As String
    Dim CopyToRow As Integer

    With Application
        .EnableEvents = False
        .ScreenUpdating = False

    '   Use this code to suppress "sheet deletion" warning
        .DisplayAlerts = False
        
    End With

    'MSG BOX TO ASK IF USER INTENDS TO UPDATE FILE

   If MsgBox("Do you wish to update the NRO Spreadsheet - News?", vbYesNo, "UPDATE") = vbNo Then Exit Sub
 
    Set Sourcewb = ThisWorkbook
    
        'VARIABLES TO TRIM NAME OF SOURCE WORKBOOK DOWN TO NEW OR REVIEW
'GET ONLY FILENAME (LEFT OF .)

        strNewReviewExt = Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1)

'FIND POSITION OF THE HYPHEN
    
        pos = InStrRev(strNewReviewExt, "-")

'GRAB LETTERS TO THE RIGHT OF THE HYPHEN
    
        strNewReview = Trim(Right(strNewReviewExt, Len(strNewReviewExt) - pos))

'REMOVE THE S FROM THE END
    
        strNewReviewFINAL = Replace(strNewReview, "s", "")

'VARIABLE TO NAME DESIRED WORKSHEET IN SOURCEWB
        
        Set MainWS = Sourcewb.Worksheets(strNewReviewFINAL)
        
        
        
      On Error Resume Next

,CLEAR ALL FILTERS AND FIND LAST USED ROW

                    If MainWS.Visible Then MainWS.ShowAllData
        
        CopyToRow = MainWS.Range("A" & Rows.Count).End(xlUp).Row + 1
        
        
    
    'Name the folder to use
    ChDir "\\qldhealth\.Herston-CL1_DATA10.Herston.IN-BNE.BNS.HEALTH\RBWHNRO\ESM Daily Reports"
    
    'which file is it?
    UpdateFileName = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
    If UpdateFileName = False Then Aborted = True: Exit Sub

    'ASSIGN VARIABLE NAME FOR OTHER WORKBOOK
           Set ESMwb = Workbooks.Open(UpdateFileName)
    
               With ESMwb

'USE SELECT SHEET TO UNGROUP
               .Sheets(1).Select
             
'ALL SHEETS UNFILTER AND UNHIDE RCs
                For Each WS In ESMwb.Worksheets
                On Error Resume Next

                    If WS.Visible Then WS.ShowAllData

                        On Error GoTo 0     
                    
                        WS.UsedRange.EntireColumn.Hidden = False
                        WS.UsedRange.EntireRow.Hidden = False
                Next WS
            
            End With
    'MERGE ALL SHEETS ONTO MASTER SHEET, REORDER COLUMNS, FILTER FOR WHAT WE WANT
    Application.Run "CopyFromWorksheets"
 
'COPY ALL BUT LAST COLUMN TO SOURCEWB
    With ESMwb.ActiveSheet.AutoFilter.Range
    .Offset(1, 0).Resize(.Rows.Count - 1, 11).Copy Destination:=MainWS.Range("A" & CopyToRow)
    
    End With
   
  'CLOSE OTHER WORKBOOK WITHOUT SAVING 
    ESMwb.Close (False)

    'Inform the user the macro is completed
    MsgBox "The file ''" & UpdateFileName & "'' has successfully updated the NRO Spreadsheet - " & strNewReview & ".", _
           64, "Update Complete."
End Sub



Sub CopyFromWorksheets()

'/// This code assumes that ALL worksheets have the same field structure; same column headings, and the same column order.
'/// The code copies all rows into one new worksheet called Master.
'/// think this was written by smozgur (VBA Express???)
 
    Dim wrk As Workbook 'Workbook object - Always good to work with object variables
    Dim sht As Worksheet 'Object for handling worksheets in loop
    Dim trg As Worksheet 'Master Worksheet
    Dim rng As Range 'Range object
    Dim colCount As Integer 'Column count in tables in the worksheets
     
    Set wrk = ActiveWorkbook 'Working in active workbook
     
    For Each sht In wrk.Worksheets
        If sht.Name = "Master" Then
            MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _
            "Please remove or rename this worksheet since 'Master' would be" & _
            "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
            Exit Sub
        End If
    Next sht
     
     'We don't want screen updating
    Application.ScreenUpdating = False
     
     'Add new worksheet as the last worksheet
    Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
     'Rename the new worksheet
    trg.Name = "Master"
     'Get column headers from the first worksheet
     'Column count first
    Set sht = wrk.Worksheets(1)
    colCount = sht.Cells(1, 255).End(xlToLeft).Column
     'Now retrieve headers, no copy&paste needed
    With trg.Cells(1, 1).Resize(1, colCount)
        .Value = sht.Cells(1, 1).Resize(1, colCount).Value
         'Set font as bold
        .Font.Bold = True
    End With
     
     'We can start loop
    For Each sht In wrk.Worksheets
         'If worksheet in loop is the last one, stop execution (it is Master worksheet)
        If sht.Index = wrk.Worksheets.Count Then
            Exit For
        End If
         'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
        Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(1048576, 1).End(xlUp).Resize(, colCount))
         'Put data into the Master worksheet
        trg.Cells(1048576, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
    Next sht
     'Fit the columns in Master worksheet
    trg.Columns.AutoFit
    
     Rows("2:2").Select
ActiveWindow.FreezePanes = True
     
     'Screen updating should be activated
    With Application
        .Run "ReorderColumns"
        
        .Run "Remove_unwanted_columns"
        .Run "FilterRows"
        
        .ScreenUpdating = True
    End With
    '///1048576 rows for excel 2007 onwards
    
End Sub


Sub ReorderColumns()
'Code contribution by AlphaFrog (Excel MVP) in
'http://www.mrexcel.com/forum/excel-questions/606890-reorder-columns-using-macro.html
 
  Dim arrColOrder As Variant, ndx As Integer
  Dim Found As Range, counter As Integer
 
 With ActiveWorkbook.Sheets("Master")
  'Place the column headers in the end result order you want.
    arrColOrder = Array("LOCAL_BUS_UNIT", "APPT_DATE", "APPT_TIME", "MRN", "Name", _
                "DOB", "Appointment Type", "ESM_Resource", "Referral_Length", "Referral_Expiry_Date", _
                "Referred To Named Referral (Yes/No)", "STATUS_DESCRIPTION")
 
  counter = 1
 
  Application.ScreenUpdating = False
 
    For ndx = LBound(arrColOrder) To UBound(arrColOrder)
 
    Set Found = Rows("1:1").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, _
                SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
 
        If Not Found Is Nothing Then
            If Found.Column <> counter Then
                Found.EntireColumn.Cut
                Columns(counter).Insert Shift:=xlToRight
                    Application.CutCopyMode = False
            End If
        counter = counter + 1
        End If
 
    Next ndx
 End With
  Application.ScreenUpdating = True
 
End Sub


Sub Remove_unwanted_columns()
With ActiveWorkbook
        .Sheets("Master").Range("M:Z").EntireColumn.Delete
End With
End Sub


Sub FilterRows()

Dim strDesc, strAppt, strRefLength, strNR As String
Dim rngHdr As Range
Dim af1, af2, af3, af4 As Integer

With ActiveWorkbook.Sheets("Master")

Set rngHdr = .Range("A1:L1")

    strDesc = "STATUS_DESCRIPTION"
    strAppt = "Appointment Type"
    strNR = "Referred To Named Referral (Yes/No)"
    strRefLength = "Referral_Length"

    af1 = Application.WorksheetFunction.Match(strDesc, rngHdr, 0)

    af2 = Application.WorksheetFunction.Match(strAppt, rngHdr, 0)

    af3 = Application.WorksheetFunction.Match(strNR, rngHdr, 0)

    af4 = Application.WorksheetFunction.Match(strRefLength, rngHdr, 0)

End With

    With ActiveWorkbook.Sheets("Master").Range("A1:L1")

        .AutoFilter Field:=af1, Criteria1:="<>*Expired*"

        .AutoFilter Field:=af2, Criteria1:="*" & strNewReviewFINAL & "*"

        .AutoFilter Field:=af3, Criteria1:="<>*Yes*"

        .AutoFilter Field:=af4, Criteria1:="<>*3 Months*"
    End With
End Sub


I am about to post a query regarding removing rows in the source workbook where they exist in the new workbook prior to importing them. The data relates to appointments. So, if the new data contains appointments for the first week of June (3-8), and my existing data includes appointments up to the 5th June, prior to importing the new appointments for the coming week, i need to delete any appointments in the Source workbook that are made for the 3rd, 4th, & 5th June.

I think I can do this by creating a list of dates from both workbooks using advanced filter, then deleting the records from the source workbook where the dates match. Is there an easier, or more efficient method?
 
Last edited:
Upvote 0
MainWS was already referencing Sourcewb (i.e. ThisWorkbook) so what you were saying with

Code:
Sourcewb.MainWS.Range("A" & LastRow + 1).PasteSpecial xlPasteValues
was
Code:
ThisWorkbook.ThisWorkbook.Worksheets(strNewReviewFINAL).Range("A" & LastRow + 1).PasteSpecial xlPasteValues

which is why it erred and

Code:
MainWS.Range("A" & LastRow + 1).PasteSpecial xlPasteValues

worked.
 
Upvote 0
i think in my original version, I had tried using
Code:
MainWS.Range("A" & LastRow + 1).PasteSpecial
without the xlPasteSpecial

While I remember, I also changed the variable identifying the last used row on the MainWS, "LastRow", to identify the last available plus one.

so from "LastRow" to
Code:
CopyToRow = MainWS.Range("A" & Rows.Count).End(xlUp).Row + 1
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,113,999
Members
448,541
Latest member
iparraguirre89

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