[已解决]请教工作簿间复制数据

hwc2ycy

你每次复制时，原有数据是要清除还是扣留？

yizhih

hwc2ycy 发表于 2013-5-7 09:54
啥叫B2开始的第2行，B4么？

“B2开始的第二行”就是第二行，开始从B2单元格.

yizhih

hwc2ycy 发表于 2013-5-7 10:01
你每次复制时，原有数据是要清除还是扣留？

原有的数据要清除。
谢谢！

hwc2ycy

原有的既然清除，那基本上每次全是B2单元格了。

hwc2ycy

1. Sub 按钮2_Click()
   
2.     Dim wbDst As Workbook
   
3.     Dim lCol As Long
   
4.     Dim lShtNumber As Long
   
5.     On Error GoTo ErrorHandler
   
6. 
   
7.     Application.ScreenUpdating = False
   
8.     Application.DisplayAlerts = False
   
9.     Set wbDst = GetObject(ThisWorkbook.Path & Application.PathSeparator & "工作簿2.xls")
   
10. 
    
11.     With Worksheets("sheet10")
    
12.         Debug.Print "sheet10"
    
13.         For lCol = 84 To 99 Step 3
    
14.             lShtNumber = lShtNumber + 1
    
15.             Debug.Print lCol, lShtNumber, lShtNumber + 12
    
16.             With wbDst
    
17.                 .Worksheets("sheet" & lShtNumber).UsedRange.Clear
    
18.                 .Worksheets("sheet" & lShtNumber + 12).UsedRange.Clear
    
19.             End With
    
20.             .Range(.Cells(3, lCol), .Cells(3, lCol).End(xlDown)).Copy
    
21.             With wbDst
    
22.                 .Worksheets("sheet" & lShtNumber).Cells(2, 2).PasteSpecial Transpose:=True
    
23.                 .Worksheets("sheet" & lShtNumber + 12).Cells(2, 2).PasteSpecial Transpose:=True
    
24.             End With
    
25.             Application.CutCopyMode = False
    
26.         Next
    
27.     End With
    
28. 
    
29.     lShtNumber = 7
    
30.     With Worksheets("sheet18")
    
31.         Debug.Print "sheet18"
    
32.         For lCol = 84 To 99 Step 3
    
33.             Debug.Print lCol, lShtNumber, lShtNumber + 6
    
34.             With wbDst
    
35.                 .Worksheets("sheet" & lShtNumber).UsedRange.Clear
    
36.                 .Worksheets("sheet" & lShtNumber + 6).UsedRange.Clear
    
37.             End With
    
38.             .Range(.Cells(3, lCol), .Cells(3, lCol).End(xlDown)).Copy
    
39.             With wbDst
    
40.                 .Worksheets("sheet" & lShtNumber).Cells(2, 2).PasteSpecial Transpose:=True
    
41.                 .Worksheets("sheet" & lShtNumber + 6).Cells(3, 2).PasteSpecial Transpose:=True
    
42.             End With
    
43.             lShtNumber = lShtNumber + 1
    
44.             Application.CutCopyMode = False
    
45.         Next
    
46.     End With
    
47.     Application.ScreenUpdating = True
    
48.     MsgBox "复制完成"
    
49.     wbDst.Close True
    
50.     Exit Sub
    
51. 
    
52. ErrorHandler:
    
53.     MsgBox Err.Number & vbCrLf & _
    
54.            Err.Description
    
55. End Sub

复制代码

yizhih

hwc2ycy 发表于 2013-5-7 12:00

工作簿2的Sheet1-12对了，但是工作簿2的Sheet13-18只写入了工作簿1的Sheet18的数据（这个正确），但是没有写入工作簿1的Sheet10的数据，这个数据写在工作簿2的Sheet13-18的第二行，从B2开始。
谢谢！
例如工作簿2的Sheet13

hwc2ycy

1. Sub 按钮2_Click()
   
2.     Dim wbDst As Workbook
   
3.     Dim lCol As Long
   
4.     Dim lShtNumber As Long
   
5.     On Error GoTo ErrorHandler
   
6. 
   
7.     Application.ScreenUpdating = False
   
8.     Application.DisplayAlerts = False
   
9.     Set wbDst = GetObject(ThisWorkbook.Path & Application.PathSeparator & "工作簿2.xls")
   
10. 
    
11.     With Worksheets("sheet10")
    
12.         Debug.Print "sheet10"
    
13.         For lCol = 84 To 99 Step 3
    
14.             lShtNumber = lShtNumber + 1
    
15.             'Debug.Print lCol, lShtNumber, lShtNumber + 12
    
16.             With wbDst
    
17.                 .Worksheets("sheet" & lShtNumber).UsedRange.Clear
    
18.                 .Worksheets("sheet" & lShtNumber + 12).UsedRange.Clear
    
19.             End With
    
20.             .Range(.Cells(3, lCol), .Cells(3, lCol).End(xlDown)).Copy
    
21.             With wbDst
    
22.                 .Worksheets("sheet" & lShtNumber).Cells(2, 2).PasteSpecial Transpose:=True
    
23.                 .Worksheets("sheet" & lShtNumber + 12).Cells(2, 2).PasteSpecial Transpose:=True
    
24.             End With
    
25.             Application.CutCopyMode = False
    
26.         Next
    
27.     End With
    
28. 
    
29.     lShtNumber = 7
    
30.     With Worksheets("sheet18")
    
31.         'Debug.Print "sheet18"
    
32.         For lCol = 84 To 99 Step 3
    
33.             'Debug.Print lCol, lShtNumber, lShtNumber + 6
    
34.             With wbDst
    
35.                 .Worksheets("sheet" & lShtNumber).UsedRange.Clear
    
36.                 '.Worksheets("sheet" & lShtNumber + 6).UsedRange.Clear
    
37.             End With
    
38.             .Range(.Cells(3, lCol), .Cells(3, lCol).End(xlDown)).Copy
    
39.             With wbDst
    
40.                 .Worksheets("sheet" & lShtNumber).Cells(2, 2).PasteSpecial Transpose:=True
    
41.                 .Worksheets("sheet" & lShtNumber + 6).Cells(3, 2).PasteSpecial Transpose:=True
    
42.             End With
    
43.             lShtNumber = lShtNumber + 1
    
44.             Application.CutCopyMode = False
    
45.         Next
    
46.     End With
    
47.    
    
48.     Application.ScreenUpdating = True
    
49.     MsgBox "复制完成"
    
50.     Application.DisplayAlerts = False
    
51.     wbDst.Close True
    
52.     Application.DisplayAlerts = True
    
53.     Exit Sub
    
54. 
    
55. ErrorHandler:
    
56.     MsgBox Err.Number & vbCrLf & _
    
57.            Err.Description
    
58. End Sub

复制代码

第二次清除多余了，所以没有了，

yizhih

hwc2ycy 发表于 2013-5-7 12:41
第二次清除多余了，所以没有了，

万分感谢 hwc2ycy 老师，您写的非常好，很正确。再次感谢您。

hwc2ycy

惭愧啊，到现在才理解清了你的意图，{:3812:}