首次运行时出现Pastespecial错误

时间:2016-04-26 14:31:07

标签: excel excel-vba vba

此子设置为从一个工作表复制信息并将值粘贴到新的CSV工作簿中。我一直在pastespecial上遇到运行时错误,但是,只有在打开电子表格后的第一次点击时,如果我再次点击它就会完美运行。即使它给我一个错误,当我点击结束它仍然粘贴值。

Sub export_save()

Dim nrows As Integer
Dim norders As Integer
Dim i As String
Dim cell As Range
Dim fname As String
Dim WS As Worksheet
Dim WK As Workbook
Set WK = Workbooks.Add
Dim k As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
k = 2
i = "DO" 'plant to plant movement


'name new file
On Error GoTo canceled
fname = InputBox("Please name the new file, exlude any filename   extensions.", "Export Data")

WK.SaveAs Filename:="S:\Active Customers\Teknor Apex\Feeds\Orders\" & fname, _
    FileFormat:=xlCSV
    MsgBox ("File saved to file path:S:\Active Customers\Teknor  Apex\Feeds\dev\" & fname)

'copy info over
Workbooks("Teknor Template dev").Worksheets("REFORMATTED").Activate
nrows = Rows(Rows.Count).End(xlUp).Row
Workbooks("Teknor Template dev").Worksheets("REFORMATTED").Range("A3:AG" & nrows).copy
WK.Activate
Range("A1:AG" & nrows).PasteSpecial xlPasteValues, Operation:=xlNone,  SkipBlanks _
    :=False, Transpose:=False


'remove parentheses
norders = Rows(Rows.Count).End(xlUp).Row
Range("AI2").FormulaR1C1 = "=MID(RC[-14],FIND(""("",RC[-14],1)+1,3)"
Range("AI2").AutoFill Destination:=Range("AI2:AI" & norders),  Type:=xlFillDefault
Range("AI2:AI" & norders).copy
Range("U2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,  SkipBlanks:=False, Transpose:=False
Columns("AI:AI").Delete Shift:=xlToLeft

'remove ship paratheses in DO orders
For Each cell In Range("B2:B" & norders)
    If cell.Value = i Then
        Range("AI" & k).FormulaR1C1 = "=MID(RC[-13],FIND("" ("",RC[-13],1)+1,3)"
        Range("AI" & k).copy
        Range("V" & k).PasteSpecial xlPasteValues, Operation:=xlNone,  SkipBlanks:=False, Transpose:=False
    End If
    k = k + 1
Next cell

'delete extra column used to remove paratheses
Columns("AI:AI").Delete Shift:=xlToLeft

WK.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True

canceled:

End Sub

为了清楚起见,这里是一个只包含错误的较小版本,它位于专用行中。

Workbooks("Teknor Template dev").Worksheets("REFORMATTED").Activate
nrows = Rows(Rows.Count).End(xlUp).Row
Workbooks("Teknor Template dev").Worksheets("REFORMATTED").Range("A3:AG" & nrows).copy
WK.Activate
Range("A1:AG" & nrows).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

1 个答案:

答案 0 :(得分:0)

变化:

Range("A1:AG" & nrows).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

要:

Range("A1:AG" & nrows).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

您的代码遗失Paste:=

相关问题