행을 워크 시트 이름과 동일한 셀을 다른 워크 시트로 이동

Question

저는 VB가 처음입니다. 셀 값이 다른 워크 시트의 이름과 같은 다른 워크 시트로 행을 이동하는 방법을 알려주십시오.

기본적으로 ... 내 첫 번째 워크 시트 (모든 데이터)에는 SQL 스크립트에서 채워지는 데이터 범위가 있습니다. A 열에는 CS Reps의 이름이 있습니다. 각 CS 담당자에게는 자체 워크 시트가 있습니다.

내가 필요한 것은 VB가 셀 A2 (모든 데이터)를 확인하고 해당 CS Rep 워크 시트의 A2 : M2에서 A2 : M2로 셀 범위를 이동하는 것입니다. 그런 다음 모든 데이터 행을 삭제해야합니다.

'모든 데이터'의 모든 행이 해당 CS 담당자의 워크 시트로 이동 될 때까지이 프로세스가 루프에 있어야합니다. 불일치가 있으면 '불일치'라는 다른 워크 시트로 이동할 수 있습니다. 일치하는 행은 항상 기존 데이터를 한 행 아래로 이동시키는 해당 워크 시트의 행 2로 복사해야합니다.

나는 그것이 정말로 의미가 있기를 바란다!

감사 SMORF

하위 MoveToCS()

Sheets("All Data").Select 
Cells.Select 
ActiveWorkbook.Worksheets("All Data").sort.SortFields.Clear 
ActiveWorkbook.Worksheets("All Data").sort.SortFields.Add Key:=Range(_ 
    "A2:A357"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
    xlSortNormal 
With ActiveWorkbook.Worksheets("All Data").sort 
    .SetRange Range("A1:M357") 
    .Header = xlYes 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 
Cells.Select 
Selection.AutoFilter 
ActiveSheet.Range("$A$1:$M$1000").AutoFilter Field:=1, Criteria1:="ACHAL" 
Range("A2:M1000").Select 

Selection.Copy 
Sheets("ACHAL").Select 
Range("A2").Select 
Application.CutCopyMode = False 
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
Sheets("All Data").Select 
Selection.EntireRow.Delete 
ActiveSheet.Range("$A$1:$M$286").AutoFilter Field:=1 

최종 하위

Answer 1

내가 사용하는 다음 :

이

ActiveCell.EntireRow.Insert '이이 경우에, 새로운 행을 삽입 [ "일치하는 행은 항상 기존 데이터를 행 아래로 이동시키는 해당 워크 시트의 2 행으로 복사해야합니다."]

Activecell.EntireRow.Copy '이것은 모든 활성 행을 복사합니다.

ActiveCell.PasteSpecial '클립 보드에 데이터를 붙여 넣을 때이 줄이 복사 줄 뒤에 있는지 확인하십시오.

ActiveCell.EntireRow.Delete '이렇게하면 MySQL 데이터 소스가 들어있는 시트에서 데이터를 삭제할 수 있습니다.

이것에 따르면 데이터를 정렬 할 필요가 없다고 생각합니다. 시트의 전체 첫 번째 열 (모든 데이터)을 이동하는 루프를 작성하고 activecell 값을 평가하고 데이터는 특정 시트를 선택하고 정보를 붙여 넣기 한 후, 메인 시트에 돌아가, 붙여 넣기이 같은를 ActiveCell 및 루프, 뭔가를 삭제 :

Sub Main() 
    Sheets("All Data").Activate 
    Range("A2").Activate 
    Dim SheetToPaste As String 
    Do While ActiveCell.Value <> "" 
     Select Case ActiveCell.Value 
      Case "Hoja2" 
       SheetToPaste = "Hoja2" 
      Case "Hoja3" 
       SheetToPaste = "Hoja3" 
      Case Else 
       SheetToPaste = "Mismatch" 
     End Select 
     ActiveCell.EntireRow.Copy 
     Sheets(SheetToPaste).Activate 
     Range("A2").Activate 
     ActiveCell.EntireRow.Insert 
     Application.CutCopyMode = False 
     Sheets("All Data").Activate 
     ActiveCell.EntireRow.Delete 
    Loop 
End Sub 

는 작동 바랍니다.