[英]Excel VBA copying rows using autofilter
Looking to copy rows from all sheets apart from my active sheet that meet a certain criteria in column J using VBA. 希望使用VBA从活动工作表中复制满足我J列中特定条件的所有工作表中的行。
Not experienced in writing code in VBA so I have tried to frankenstein together the necessary parts from looking through other questions and answers; 没有用VBA编写代码的经验,所以我尝试着从其他问题和答案中找出必要的部分。
below is the code I have written so far; 以下是我到目前为止编写的代码;
Sub CommandButton1_Click()
Dim lngLastRow As Long
Dim ws As Worksheet
Dim r As Long, c As Long
Dim wsRow As Long
Set Controlled = Sheets("Controlled") ' Set This to the Sheet name you want all Ok's going to
Worksheets("Controlled").Activate
r = ActiveSheet.Cells(Rows.Count, 2).End(x1up).Row
c = ActiveSheet.Cells(1, Columns.Count).End(x1ToLeft).Column
Range("J").AutoFilter
For Each ws In Worksheets
If ws.Name <> "Controlled" Then
ws.Activate
wsRow = ActiveSheet.Cells(Rows.Count, 2).End(x1up).Row + 1
Range("A" & r).AutoFilter Field:=10, Criteria1:="Y"
.Copy Controlled.Range("A3" & wsRow)
End If
Next ws
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
Where Controlled is the sheet I want the data to appear in from the other sheets, and all other sheets are searched to see if their column J meets the criteria="Y" 我希望数据从其他工作表中出现在“受控”工作表中,然后搜索所有其他工作表以查看其列J是否满足条件=“ Y”
I won't need to copy over formatting as all Sheets will have the formatting exactly the same and if possible I want the rows that are copied over to start at row 3 我不需要复制格式,因为所有工作表的格式都完全相同,如果可能,我希望复制的行从第3行开始
Try this: 尝试这个:
Option Explicit
Sub ConsolidateY()
Dim ws As Worksheet, wsCtrl As Worksheet
Dim lrow As Long, rng As Range
Set wsCtrl = Thisworkbook.Sheets("Controlled")
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
For Each ws In Thisworkbook.Worksheets
If ws.Name = "Controlled" Then GoTo nextsheet
With ws
lrow = .Range("J" & .Rows.Count).End(xlUp).Row
.AutoFilterMode = False
Set rng = .Range("J1:J" & lrow).Find(what:="Y", after:=.Range("J" & lrow))
If rng Is Nothing Then GoTo nextsheet
.Range("J1:J" & lrow).AutoFilter Field:=1, Criteria1:="Y"
.Range("J1:J" & lrow).Offset(1,0).SpecialCells(xlCellTypeVisible).EntireRow.Copy
wsCtrl.Range("A" & wsCtrl.Rows.Count).End(xlUp).Offset(1,0).PasteSpecial xlPasteValues
.AutoFilterMode = False
Application.CutCopyMode = False
End With
nextsheet:
Next
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
I think this covers everything or most of your requirement. 我认为这涵盖了您的所有要求或大部分要求。
Not tested though so I leave it to you. 虽然没有经过测试,所以我留给您。
If you come across with problems, let me know. 如果您遇到问题,请告诉我。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.