筛选姓名（可变）复制数据同名的行，谢谢！！！

yl858 · 发表于 2022-12-26 19:34

求助VBA.rar (16.27 KB, 下载次数: 8)

nicleyuan · 发表于 2022-12-26 19:53

tiger1976 · 发表于 2022-12-26 20:13

Sub lll()

Dim str As String
Dim i As Integer
Dim k As Integer
Dim rng As Range

str = Sheets("结果").Range("d3").Text
i = Sheets("数据").Cells(Rows.Count, 4).End(xlUp).Row

For Each rng In Sheets("数据").Range("d5:d" & i)
      If rng.Value = str Then
         rng.EntireRow.Copy
         k = k + 1
         Sheets("结果").Cells(k + 4, 1).Select
         ActiveCell.PasteSpecial

      End If
Next

End Sub

gwjkkkkk · 发表于 2022-12-26 20:22

请楼主参考附件。。。

yl858 · 发表于 2022-12-26 20:27

谢谢 nicleyuan ！！！
Sub t10()
Application.ScreenUpdating False
Sheets("结果").[b5:n10000].ClearContents
With Sheets("数据").Select
Dim r
r Cells(Rows.Count, 4).End(xlUp).Row
Range("a2").Auto Filter field:=4,Criteria1:=Sheets("结果").[d3]
Range(Cells(5,2),Cells(,13).Copy Sheets("结果").[b5]
End With
Sheets("结果").Select
Application.ScreenUpdating True
EXCELHOME.NET
End Sub
好像编译错误

yl858 · 发表于 2022-12-26 20:38

谢谢 gwjkkkkk
问题解决

nicleyuan · 发表于 2022-12-26 21:35

demo 2

yl858 · 发表于 2022-12-26 21:44

本帖最后由 yl858 于 2022-12-26 22:04 编辑

谢谢 tiger1976 nicleyuan
如果变换名字就执行，怎样改？谢谢！！！！！！

mmwwdd · 发表于 2022-12-27 06:07

mmwwdd · 发表于 2022-12-27 06:09

yl858 发表于 2022-12-26 21:44
谢谢 tiger1976 nicleyuan
如果变换名字就执行，怎样改？谢谢！！！！！！

给你弄了，请给花

		自动登录	找回密码
密码			免费注册

[求助] 筛选姓名（可变）复制数据同名的行，谢谢！！！