VB
Sub Copy_To_Another_Sheet() Dim FirstAddress As String Dim Arr As Variant Dim Rng As Range Dim Rcount As Long Dim I As Long Application.ScreenUpdating = False Arr = Array("x","y") Rcount = 0 With Sheets("jd_soy").Range("g1:G3019") For I = LBound(Arr) To UBound(Arr) Set Rng = .Find(what:=Arr(I),_ After:=.Rows(.Rows.Count),_ LookIn:=xlFormulas,_ LookAt:=xlPart,_ SearchOrder:=xlByRows,_ SearchDirection:=xlNext,_ MatchCase:=False) If Not Rng Is Nothing Then FirstAddress = Rng.Address Do Rcount = Rcount + 1 Rng.EntireRow.Copy Rng.EntireRow.Copy Sheets("test").Range("A" & Rcount).End(xlUp).Offset(1) 'Sheets("test").Range("A" & Rcount).Value = Rng.Cells ' Worksheets("test").Cells(Rng,1).Value = Rng.Row Set Rng = .FindNext(Rng) Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress End If Next I End With Sheets("test").Select Cells.Select Cells.EntireColumn.AutoFit Range("A1").Select End Sub (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |