Option Explicit
Option Compare Text
Public Sub Test()
Dim wksSource As Excel.Worksheet
Dim wksTarget As Excel.Worksheet
Dim rngTarget As Excel.Range
Dim i As Long
For Each wksSource In ThisWorkbook.Worksheets
Select Case wksSource.Name
Case "QA", "NWA", "T1"
For i = GetLastCellWithContent(wksSource, "A").Row To 2 Step -1
If wksSource.Name <> wksSource.Cells(i, "A").Value Then
Set wksTarget = GetWorksheet(Name:=wksSource.Cells(i, "A").Value)
If Not wksTarget Is Nothing Then
Set rngTarget = GetLastCellWithContent(wksTarget, "B").Offset(1, -1)
Call wksSource.Rows(i).Cut
Call wksTarget.Paste(Destination:=rngTarget)
Call wksSource.Rows(i).Delete(xlShiftUp)
End If
End If
Next
End Select
Next
End Sub
Public Function GetLastCellWithContent(Worksheet As Excel.Worksheet, Column As Variant) As Excel.Range
Set GetLastCellWithContent = Worksheet.Cells(Worksheet.Rows.Count, Column).End(xlUp)
End Function
Public Function GetWorksheet(Name As String, Optional Workbook As Excel.Workbook) As Excel.Worksheet
On Error Resume Next
If Workbook Is Nothing Then
Set GetWorksheet = ThisWorkbook.Worksheets(Name)
Else
Set GetWorksheet = Workbook.Worksheets(Name)
End If
End Function