2016-04-26 38 views
0

該子部分設置爲從一張工作表複製信息並將其粘貼到新的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 

爲了清楚起見,這裏僅包含誤差更小的版本,這是在PasteSpecial的線。

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 

回答

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:=

+0

感謝的人,我發誓我在那裏之前,但補充說,在已經出現解決問題! – diamondjim

相關問題