숫자 값을 기준으로 여러 워크 시트의 행 복사

Question

영업 사원이 다른 판매 조건에 놓은 판매 워크 시트가 여러 개 있습니다. 특정 판매에 대한 신뢰 수준입니다. 나는 방금 VBA를 배우기 시작 했으므로 나는 단서가 없지만 이것이 내 머리 위로 있다는 것을 인정해야합니다.

행의 신뢰도가 60 %를 넘는 경우 전체 행을 새 워크 시트에 복사하고 싶습니다.

이 데이터는 행 8 일에 시작하여 신뢰 비율 열은 열 V.이다

내가 VBA 스크립트, 그들은 이름을 지정하는에 적용 할 9 개 워크 시트의 총

:

• 제프
• 존
• 팀
• 피트
• 차드
• 밥
• 케빈
• 마이크
• 빌

내가 행 8 일에 다시 한 번 시작, 마스터 또는에 복사 60 % 이상의 신뢰 수준을 가진 모든 행이 시트를 "설치"할 "Install"시트의 버튼으로 스크립트를 실행하고 싶습니다. 여기

내가 작업하고있는 무슨의 사진입니다 :

Answer 1

아래에 모든 구 시트 (이름이있는 경우)에서

• 복사 행 (8) 아래의 코드 "설치"라고하는
• 60 % 미만의 모든 레코드는 자동 필터링되고 마스터 시트에서 삭제됩니다 (복사하기 전에 9 매 각각을 자동 필터링하는 것보다 효율적 임)
알려주세요 - 16,
• 공백 행은 다음이가 세일즈맨 시트 중 하나를 복사 할 수 있습니다 7 행 ​​1에서 헤더 행을 필요로 할 경우 8

이 * 행에서 시작 "설치"를 상단에 추가 *

Sub QuickCombine() 
Dim ws1 As Worksheet 
Dim ws2 As Worksheet 
Dim rng1 As Range 
Dim strShts() 
Dim strWs As Variant 
Dim lngCalc As Long 

With Application 
.ScreenUpdating = False 
lngCalc = .Calculation 
.Calculation = xlCalculationManual 
End With 

Set ws1 = Sheets("Install") 
ws1.UsedRange.Cells.Clear 

strShts = Array("Jeff", "John", "Tim", "Pete", "Chad", "Bob", "Kevin", "Mike", "Bill") 
For Each strWs In strShts 
On Error Resume Next 
Set ws2 = Sheets(strWs) 
On Error GoTo 0 
If Not ws2 Is Nothing Then 
Set rng1 = ws2.Range(ws2.[v8], ws2.Cells(Rows.Count, "v").End(xlUp)) 
rng1.EntireRow.Copy ws1.Cells(ws1.Cells(Rows.Count, "v").End(xlUp).Offset(1, 0).Row, "A") 
End If 
Set ws2 = Nothing 
Next 
With ws1 
    .[v1] = "dummy" 
    .Columns("V").AutoFilter Field:=1, Criteria1:="<60%" 
    .Rows.Delete 
.Rows("1:7").Insert 
End With 
With Application 
.ScreenUpdating = True 
.Calculation = lngCalc 
End With 
End Sub