Re: Runtime Error Paste Method of Worksheet class failed

Tech-Archive recommends: Fix windows errors by optimizing your registry

Thank you, it worked!!!!!!!!!!!!!!
--
ca1358


"Dave Peterson" wrote:

> Sometimes a command can kill the clipboard.
>
> Maybe rearranging the commands would help:
>
> workbooks.add
> rngtocopy.copy
> active***.paste
>
> (I didn't look at any other code.)
>
> ca1358 wrote:
> >
> > This stop at Add Work***
> >
> > Workbooks.Add
> > Active***.Paste
> >
> > What is wrong?
> >
> > Private Sub CommandButton1_Click()
> >
> > 'Copy Data and transfer to New Workbook
> >
> > Dim rngToCopy As Range
> > Dim rngToPaste As Range
> >
> > Set rngToCopy = Sheets("temptable").Cells(Rows.Count,
> > "A").End(xlUp).Offset(1, 0)
> >
> >
> > 'Open new workbook to create text file
> >
> > Workbooks.Add
> > Active***.Paste
> > Application.CutCopyMode = False
> >
> > Sheets("Sheet3").Select
> > ActiveWindow.SelectedSheets.Delete
> >
> > Sheets("Sheet2").Select
> > ActiveWindow.SelectedSheets.Delete
> >
> > Application.CutCopyMode = False
> >
> >
> > 'Export Text File
> > ADOFromExcelToAccess
> >
> > ' Turns off "Do you want to replace this file?"
> > Application.DisplayAlerts = False
> >
> > 'Saves as a text file
> > ActiveWorkbook.SaveAs Filename:="C:\Documents and
> > Settings\n574824\Databases\Pricing Tool\TransferFile.txt" _
> > , FileFormat:=xlText, CreateBackup:=False
> >
> > ActiveWorkbook.Close
> >
> > 'opens access
> >
> > Range("Q23").Select
> >
> >
> > Active***.Hyperlinks.Add Anchor:=Selection, Address:="Volume.mdb", _
> >
> > Range("Q23").Select
> >
> > Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
> >
> >
> >
> > 'Open a form in Access
> > Dim App As Object
> > Set App = GetObject("C:\Documents and Settings\n574824\Databases\Pricing
> > Tool\Volume.mdb")
> >
> >
> > App.Application.docmd.openform "Form"
> >
> >
> > End Sub
> >
> > Sub ADOFromExcelToAccess()
> > ' exports data from the active work*** to a table in an Access database
> > ' this procedure must be edited before use
> > Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
> > ' connect to the Access database
> > Set cn = New ADODB.Connection
> > cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
> > "Data Source=C:\Documents and Settings\n574824\Databases\Pricing
> > Tool\Volume.mdb;"
> > ' open a recordset
> > Set rs = New ADODB.Recordset
> > rs.Open "TransferFile", cn, adOpenKeyset, adLockOptimistic, adCmdTable
> > cn.Execute "delete * from TransferFile"
> >
> > ' all records in a table
> > r = 2 ' the start row in the work***
> > Do While Len(Range("A" & r).Formula) > 0
> > ' repeat until first empty cell in column A
> > With rs
> > .AddNew ' create a new record
> > ' add values to each field in the record
> > .Fields("Coupon") = Range("A" & r).Value
> > .Fields("Note") = Range("B" & r).Value
> > .Fields("Desk") = Range("D" & r).Value
> > .Fields("Early") = Range("E" & r).Value
> > .Fields("BuyUp") = Range("F" & r).Value
> > .Fields("Buydown") = Range("J" & r).Value
> > .Fields("Net") = Range("K" & r).Value
> > .Fields("BaseSRP") = Range("L" & r).Value
> > .Fields("MandAdjusters") = Range("M" & r).Value
> > .Fields("Desk") = Range("N" & r).Value
> > .Fields("Note2") = Range("O" & r).Value
> > .Fields("Buyup_Down") = Range("P" & r).Value
> > .Fields("ProductType") = Range("Q" & r).Value
> > .Fields("Par") = Range("S" & r).Value
> > .Fields("AS400 ID") = Range("T" & r).Value
> > .Fields("CLient Name") = Range("U" & r).Value
> > .Fields("DelDt") = Range("V" & r).Value
> > .Fields("PED") = Range("W" & r).Value
> > .Fields("PoolMth") = Range("X" & r).Value
> >
> >
> > ' add more fields if necessary...
> > .Update ' stores the new record
> > End With
> > r = r + 1 ' next row
> > Loop
> >
> >
> >
> > rs.Close
> > Set rs = Nothing
> > cn.Close
> > Set cn = Nothing
> >
> >
> >
> >
> >
> > End Sub
> >
> > --
> > ca1358
>
> --
>
> Dave Peterson
>
.

Quantcast