[已解决]请问：用VBA 如何提取不固定区域的每周数据

byhdch

回复 zjdh 的帖子

zjdh老师! 请问:数据复制时能否只复制本月及上月,若数据很多时,不必全复制,代码如何变动?                 谢谢!

byhdch

zjdh 发表于 2011-11-7 08:58

谢谢！！！

byhdch

zjdh 发表于 2011-11-7 08:58

zjdh老师:
     数据复制为什么中断,请帮助看看代码。          谢谢！

zjdh

1. Sub test()
   
2.     Application.DisplayAlerts = False
   
3.     Set WK = Workbooks.Open(ThisWorkbook.Path & "\数据.xls")
   
4.     With WK
   
5.         Sheets.Add(after:=Sheets(Sheets.Count)).Name = "TEMP"
   
6.         ActiveSheet.Name = "TEMP"
   
7.         For Each SH In .Sheets
   
8.             If SH.Name <> "TEMP" Then
   
9.                 SH.Range("A2:X" & SH.Range("B65536").End(3).Row - 4).Copy .Sheets("TEMP").Range("A65536").End(3)(14)
   
10.             End If
    
11.         Next
    
12.         Arr = .Sheets("TEMP").Range("A14:X" & .Sheets("TEMP").Range("B65536").End(3).Row)
    
13.         .Sheets("TEMP").Delete
    
14.         .Close False
    
15.     End With
    
16.     Range("B7:Y90").ClearContents
    
17.     For i = 2 To UBound(Arr) Step 12
    
18.         If Date < Arr(i, 1) Then
    
19.             W = 7      '从第七行开始
    
20.             For J = i - 84 To i - 1
    
21.                 For N = 1 To 24
    
22.                     Cells(W, N + 1) = Arr(J, N)
    
23.                 Next
    
24.                 W = W + 1
    
25.             Next
    
26.             Exit For
    
27.         End If
    
28.     Next
    
29.     Application.DisplayAlerts = True
    
30. End Sub

复制代码