[已解决]求助高手们来看看。

hwc2ycy

exlover 发表于 2013-10-21 23:21
谢谢。也就是我把sheet3里的数据全部清空后。
做这样的复制，是从sheet3的第三行开始填入的。
不过，就 ...

改都简单的，只要沟通好，这都不是问题。

exlover

hwc2ycy 发表于 2013-10-21 23:23
改都简单的，只要沟通好，这都不是问题。

hwc2ycy老师，在代码的哪段稍做修改的。

hwc2ycy

1. Sub test2()
   
2.     Dim rg As Range, rg2 As Range
   
3.     Dim lLastRow As Long
   
4.     Dim arr
   
5.     On Error Resume Next
   
6.     If TypeName(Selection) <> "Range" Then MsgBox "选择的非单元格区域": Exit Sub
   
7.    
   
8.     Set rg = Selection
   
9.     With Worksheets("sheet3")
   
10.         .UsedRange.Clear
    
11.         lLastRow = 1
    
12.         For Each rg2 In rg.Areas
    
13.             arr = rg2.Value
    
14.             With .Cells(lLastRow, 1)
    
15.                 If IsArray(arr) Then
    
16.                     .Resize(UBound(arr), UBound(arr, 2)).Value = arr
    
17.                 Else
    
18.                     .Value = arr
    
19.                 End If
    
20.             End With
    
21.             lLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 2
    
22.         Next
    
23.     End With
    
24.     MsgBox "复制完成"
    
25. End Sub

复制代码

EPTWO 的代码，清除原有SHEET3的代码，从第一行开始写入。
刚看到有说是每段要间隔一行吧。

hwc2ycy

EPONE的SHEET2是否也要从第一行开始，清空原有内容？

1. Sub test1()
   
2.     Dim rg As Range, rg2 As Range
   
3.     Dim lLastRow As Long
   
4.     Dim arr
   
5.     On Error Resume Next
   
6.     If TypeName(Selection) <> "Range" Then MsgBox "选择的非单元格区域": Exit Sub
   
7.    
   
8.     Set rg = Selection
   
9. 
   
10.     With Worksheets("sheet2")
    
11.         .UsedRange.Clear
    
12.         For Each rg2 In rg.Areas
    
13.             arr = rg2.Value
    
14.             lLastRow = 1
    
15.             With .Cells(lLastRow, 1)
    
16.                 If IsArray(arr) Then
    
17.                     .Resize(UBound(arr), UBound(arr, 2)).Value = arr
    
18.                 Else
    
19.                     .Value = arr
    
20.                 End If
    
21.             End With
    
22.             lLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    
23.         Next
    
24.     End With
    
25.     MsgBox "复制完成"
    
26. End Sub

复制代码