VBA/행을 다른 여러 시트로 자동으로 이동하는 매크로

Question

VBA/매크로는 익숙하지만 익숙하지 않고 고생하고 있습니다. 나는 YouTube 비디오에 예제를 올려 놓고 온라인에 게시 된 다른 코드를 가지고 놀아 보았지만 큰 도움이 필요하다.

내 통합 문서에 4 장이있다. 모두 레이아웃이 같고 첫 번째 열은 내 머리글이며 필터가 있습니다. L 다음의 모든 열은 숨겨 지거나 삭제됩니다.

응용 프로그램의 첫 번째 시트 (2 월 - 모니터)에 정보를 복사/붙여 넣기 "예가 텍스트의 열 시트에 있습니다. 모든 항목을 실행중인 올바른 열로 이동하는 매크로가 있습니다. 첫 번째 시트

이 실행 때 그래서 내가 처음 시트에 대한 매크로를 싶습니다

, 그것은 다음을 수행합니다;. 열 G의 정보에

봐과에서 해당 시트로 이동 다음 빈 행

보류 -이 시트에 "DA"또는 "I"인 것을 옮깁니다. 수락 ed - "AC"인 모든 것을이 시트로 옮깁니다. Released - "RL"인 것을이 시트로 옮깁니다.

"T"(T 다음 두 공백) 또는 "RT"(RT 후 하나의 공백) 문자 옆에 G 열의 일부 셀에 나타나는 공백이 있습니다.

다른 시트의 경우 "Module1"에있는 코드를 수정하여 특정 상태의 키를 입력하면 다른 시트의 보류, 승인 및 릴리스 시트에 대한 행을 자동으로 이동시키는 방법을 알고 싶습니다. . 코드를 가지고 놀았지만 작동하도록 만들 수 있지만 빈 행으로 이동하는 대신 첫 번째 행을 덮어 씁니다.

2월이 - 모니터 - 건 RT, T, RE, RJ로 키잉은 제 시트 대기 중으로 이동 - AC이 이동으로 건에 맞 -이 시트 에 DA 또는 I 이동로 키잉 아무것도 수락 시트. Released - RL로 입력 된 내용이이 시트로 이동합니다.

Google 드라이브의 스프레드 시트에 대한 링크. https://drive.google.com/open?id=0B6fek87_mXuEMnVCRUtobVVqQU0

은 대부분 그 대답 경우의 많은이 있습니다

Answer 1

감사. 주로 "set ws"섹션. 각 "set"명령의 오른쪽에 나는 그 페이지로 전송되어야하는 문자열을 넣습니다. 그게 다 맞습니까? 그렇다면 데이터를 가져올 때 Worksheets로 가져옵니다 ("Feb - Monitor")? 이것이 G 열의 문자열을 검색하는 기본 페이지입니까? 이 모든 것이 정확하다면 이것은 당신을 위해 일해야합니다. 통합 문서의 복사본을 만들어 복사본에서 먼저 시도하십시오. VBA 편집기에서 일반 모듈을 만들어이 모듈에 붙여 넣습니다. G 열의 문자열을 기반으로 행을 복사하여 해당 페이지에 붙여 넣습니다. 다른 페이지로 복사 한 후 워크 시트 ("Feb - Monitor")에서 해당 행을 제거하려면 down에서 nextRow = 2의 주석 처리를 제거하십시오.

Sub Macro1() 
'Feb - Monitor - Anything keyed in as RT, T, RE, RJ 
'is moved to the first sheet Pending - 
'Anything keyed in as DA or I moves to this sheet Accepted - 
'Anything keyed in as AC moves to this sheet. Released - 
'Anything keyed in as RL moves to this sheet. 

Dim ws1 As Worksheet 
Dim ws2 As Worksheet 
Dim ws3 As Worksheet 
Dim ws4 As Worksheet 
Dim lastRow As Long 
Dim nextRow As Long 
Dim myArray() As Variant 


Set ws1 = Worksheets("Feb - Monitor") ' RT, T, RE, RJ 
Set ws2 = Worksheets("Pending") ' DA, I 
Set ws3 = Worksheets("Accepted") ' AC 
Set ws4 = Worksheets("Released") ' RL 

lastRow = ws1.Range("G65536").End(xlUp).Row 

myArray = ws1.Range("G2:G" & lastRow) 


For i = LBound(myArray) To UBound(myArray) 
    If InStr(1, myArray(i, 1), "T") > 0 And InStr(1, myArray(i, 1), "RT") = 0 Or _ 
     InStr(1, myArray(i, 1), "RT") > 0 Or InStr(1, myArray(i, 1), "RE") > 0 Or _ 
     InStr(1, myArray(i, 1), "RJ") > 0 Then 
     ' These need to stay on Worksheets("Feb - Monitor") so we do nothing 
     ' The reason I added this loop is in case I misunderstood your need 
     ' This loop is not necessary if we are'nt moving them 
    End If 
    If InStr(1, myArray(i, 1), "DA") > 0 Or InStr(1, myArray(i, 1), "I") > 0 Then ' send to "Pending" 
     nextRow = ws2.Range("G65536").End(xlUp).Row + 1 

     ws1.Rows(i + 1).Copy Destination:=ws2.Range("A" & nextRow) 
    End If 
    If InStr(1, myArray(i, 1), "AC") > 0 Then ' send to "Accepted" 
     nextRow = ws3.Range("G65536").End(xlUp).Row + 1 
     ws1.Rows(i + 1).Copy Destination:=ws3.Range("A" & nextRow) 
    End If 
    If InStr(1, myArray(i, 1), "RL") > 0 Then ' send to "Released" 
     nextRow = ws4.Range("G65536").End(xlUp).Row + 1 
     ws1.Rows(i + 1).Copy Destination:=ws4.Range("A" & nextRow) 
    End If 

Next i 


'********************************************* 
' The following code deletes all rows on worksheets("Feb - Monotor) 
' that are not RT, T, RE, RJ 
' You can uncomment it if you want to do that 

'nextRow = 2 
'For i = LBound(myArray) To UBound(myArray) 
' nextRow = nextRow + 1 
' If InStr(1, myArray(i, 1), "DA") > 0 Or InStr(1, myArray(i, 1), "I") > 0 _ 
'  Or InStr(1, myArray(i, 1), "AC") Or InStr(1, myArray(i, 1), "RL") > 0 Then 
'  nextRow = nextRow - 1 
'  Debug.Print i, myArray(i, 1), nextRow 
'  ws1.Rows(nextRow).Delete Shift:=xlUp 
' End If 
'Next i 

Set ws1 = Nothing 
Set ws2 = Nothing 
Set ws3 = Nothing 
Set ws4 = Nothing 


End Sub