[求助]双文档Copy paste问题![已经解决!]

huhui578

Public Sub DAT()
    i = 1
    J = 1
100
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlSht As Excel.Worksheet
    Set xlApp = CreateObject("Excel.Application")
    Set xlApp = New Excel.Application
    xlApp.Visible = True
    Set xlBook = xlApp.Workbooks.Open(ThisWorkbook.Path & "\" & Workbooks("BOOM.xls").Worksheets("Sheet1").Range("A" & i))
    Set xlSht = Workbooks("BOOM.XLS").Sheets("Sheet2")
    Set xlSheet = xlBook.Worksheets("Packing LIST")
    xlSheet.Range("A22:O34").Copy
    xlSht.Activate
    ActiveSheet.Paste Destination:=xlSht.Range("A" & J & ":O" & J + 12)
    J = J + 35
    xlBook.Close
    xlApp.Quit
    Set xlApp = Nothing
    If i = 2 Then
        Exit Sub
    Else
        i = i + 1
        GoTo 100
    End If
End Sub

[此贴子已经被作者于2006-10-31 10:06:21编辑过]

qee用

Paste时是否保证在活动工作表?

建议楼主上传附件,便于大家帮你调试

huhui578

MyGod,附件上传后不显示咧...

qee用

看不出你要怎么粘贴,权做简单修改:
Public Sub DAT()
    i = 1
    J = 1
100
    'On Error Resume Next
'    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlSht As Excel.Worksheet
'    Set xlApp = CreateObject("Excel.Application")
'    Set xlApp = New Excel.Application
'    xlApp.Visible = True
   
    '==============================ÎļþÃû´æ´¢ÔÚSheet1µÄAÁÐ
    Set xlBook = Workbooks.Open(ThisWorkbook.Path & "\" & Workbooks("BOOM.xls").Worksheets("Sheet1").Range("A" & i))

    Set xlSht = Workbooks("BOOM.XLS").Sheets("Sheet2")
    Set xlSheet = xlBook.Worksheets("Packing LIST")
    xlSheet.Activate
    xlSheet.Range("A22:O34").Select
    Selection.Copy
    Sleep 500
    xlSht.Activate
   ActiveSheet.Paste ' Destination:=Worksheets("Sheet2").Range("A" & J)
    '=====ÄÚÈÝÕ³Ìù²»ÉÏ....
    J = J + 13
    Application.CutCopyMode = False
    xlBook.Close
'    xlApp.Quit
'    Set xlApp = Nothing
    If i = 1 Then
        i = i + 1
        GoTo 100
    End If
End Sub

huhui578

呵呵,我这边也刚好解决了.谢谢楼上支持!