嗨,我正试图将信息从一个工作簿复制到另一个工作簿,并在单元格下移的同时粘贴。我的问题是根本没有粘贴信息。代码做了所有应该做的事情,除了粘贴行。
Sub filter_copy_paste()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim whatToFind As String
Dim foundTwo As Range
Dim newSelectionRange As Range
Dim rowSelectionRange As Range
Dim Found_Row As Long
Dim num As Integer
'
Sheets("Sheet1").Select
whatToFind = "Mean"
Set foundTwo = Cells.Find(What:=whatToFind, After:=ActiveCell, LookIn:=xlFormulas2, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'
Found_Row = foundTwo.row
With Sheets("Main").Range("A12:S12").CurrentRegion
.AutoFilter Field:=19, Criteria1:="Yes"
.SpecialCells(xlCellTypeVisible).EntireRow.Copy
'_
' Destination:=Sheets("Sheet1").Range("A1")
'
' I added the following line to insert selection and shift down in Cells above mean
'
Set rowSelectionRange = Rows(Found_Row - 1).Resize(1)
rowSelectionRange.Select
Selection.Insert Shift:=xlDown
End With
'
'Following is added to clean up my previous worksheet
'
Sheets("Main").Select
If ActiveSheet.FilterMode = True Then
ActiveSheet.ShowAllData
End If
Sheets("Main").Select
Rows("3:11").Select
Range("A11").Activate
Selection.EntireRow.Hidden = True
Application.CutCopyMode = False
Sheets("Sheet1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
我希望复制的行插入到平均值以上的范围内
2条答案
按热度按时间niknxzdl1#
这应该可以满足您的需要:
huwehgph2#
插入过滤的行