小白求按条件查找复制指定内容

Licai82

大哥！如附件，查找Sheet1里面‘关于’这个词，但是位置不定也就是需要范围查找，然后复制下列有数值的单元格到Sheet2数据下面单元格，非常感谢！

tmplinshi

1. Sub CopyData()
   
2. 
   
3.     Dim r1 As Range
   
4.     Dim r2 As Range
   
5.    
   
6.     Set r1 = Sheet1.Cells.Find("关于")
   
7.     Set r2 = Sheet2.Cells.Find("数据")
   
8.    
   
9.     If r1 Is Nothing Then Err.Raise 1, , "没有找到包含‘关于’字符的单元格"
   
10.     If r2 Is Nothing Then Err.Raise 2, , "没有找到包含‘数据’字符的单元格"
    
11.    
    
12.     Range(r1.Offset(1), r1.End(xlDown)).Copy r2.Offset(1)
    
13.    
    
14. End Sub

复制代码

shiruiqiang

数据少，无代表性