ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Runtime Error Paste Method of Worksheet class failed (https://www.excelbanter.com/excel-programming/349426-runtime-error-paste-method-worksheet-class-failed.html)

ca1358
Runtime Error Paste Method of Worksheet class failed
 
This stop at Add Worksheet

Workbooks.Add
ActiveSheet.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
ActiveSheet.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


ActiveSheet.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 worksheet 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 worksheet
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
Runtime Error Paste Method of Worksheet class failed
 
Sometimes a command can kill the clipboard.

Maybe rearranging the commands would help:

workbooks.add
rngtocopy.copy
activesheet.paste

(I didn't look at any other code.)

ca1358 wrote:

This stop at Add Worksheet

Workbooks.Add
ActiveSheet.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
ActiveSheet.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


ActiveSheet.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 worksheet 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 worksheet
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

ca1358
Runtime Error Paste Method of Worksheet class failed
 
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
activesheet.paste

(I didn't look at any other code.)

ca1358 wrote:

This stop at Add Worksheet

Workbooks.Add
ActiveSheet.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
ActiveSheet.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


ActiveSheet.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 worksheet 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 worksheet
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


All times are GMT +1. The time now is 05:43 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com