复值粘贴指定字段筛选数据

SCWYZJ

想复制指定的字段筛选数据粘贴到其他表（详见附件），老师再帮忙看看写vba。谢谢，小花静候！

quqiyuan

参与一下，供参考。。。

ykcbf1100

复制指定字段筛选值。

ykcbf1100

复制指定字段筛选值

1. Sub ykcbf()   '//2024.7.22   复制筛选值
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     b = [{2,3,4,5,17,18,19}]
   
5.     ReDim brr(1 To 10000, 1 To 100)
   
6.     With Sheets("复制")
   
7.         r = .Cells(Rows.Count, 3).End(xlUp).Row
   
8.         Set Rng = .[a4].Resize(r-3, 19)
   
9.         For Each Row In Rng.Rows
   
10.             If Row.Hidden = False Then
    
11.                 m = m + 1
    
12.                 zrr = Row.Value
    
13.                 For x = 1 To UBound(b)
    
14.                     brr(m, x) = zrr(1, b(x))
    
15.                 Next
    
16.             End If
    
17.         Next
    
18.     End With
    
19.     With Sheets("结果 ")
    
20.         .[f5:l10000].ClearContents
    
21.         .[f5].Resize(m, UBound(b)) = brr
    
22.     End With
    
23.     Application.ScreenUpdating = True
    
24.     MsgBox "OK！"
    
25. End Sub
    

复制代码

Qs18

Sub qs()
    rw = Sheet1.Cells(Rows.Count, 3).End(3).Row
    Sheet1.Range("B4:E" & rw & " ,Q4:S" & rw).Copy Sheet2.Range("f5")
End Sub

Qs18

Sub qs()
    rw = Sheet1.Cells(Rows.Count, 3).End(3).Row
    r2 = Sheet2.Cells(Rows.Count, "h").End(3).Row + 1
    Sheet1.Range("B4:E" & rw & " ,Q4:S" & rw).Copy Sheet2.Range("f" & r2)
End Sub

Qs18

试试........

Qs18

试试........

ykcbf1100

Qs18 发表于 2024-7-22 09:56
Sub qs()
    rw = Sheet1.Cells(Rows.Count, 3).End(3).Row
    r2 = Sheet2.Cells(Rows.Count, "h").En ...

这么简单啊，点赞！

Qs18

ykcbf1100 发表于 2024-7-22 10:21
这么简单啊，点赞！

可能是我理解得比较简单，就是复制已经筛选好的区域