Copy and paste data to separate sheets based on mutiple criteria

Ricker090,

Something like this?

Sub MoveData()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Dim ws As Worksheet, wsDest As Worksheet, wsData As Worksheet: Set wsData = Sheets("Master DATA")
    Dim DataTitle As String, wsFound As Boolean, iCell As Range
    
    Dim LastItem As Long:       LastItem = Sheets("Master DATA").Range("A" & Rows.Count).End(xlUp).Row
    Dim CurrentItem As Long:    CurrentItem = 2
    While CurrentItem <= LastItem
        
        DataTitle = wsData.Range("A" & CurrentItem).Value & wsData.Range("B" & CurrentItem).Value & wsData.Range("C" & CurrentItem).Value
        wsFound = False
        For Each ws In ThisWorkbook.Sheets
            If ws.Name = DataTitle Then
                Set wsDest = ws
                wsFound = True
                Exit For
            End If
        Next ws
        
        If wsFound = False Then
            Application.CutCopyMode = False
            wsData.Range("A1:E1").Copy
            Set wsDest = Sheets.Add(after:=Sheets(Sheets.Count))
            wsDest.Name = DataTitle
            wsDest.Range("A1").PasteSpecial xlPasteAll
            wsDest.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
        End If
        
        For Each iCell In wsData.Range("A" & CurrentItem & ":E" & CurrentItem)
            Dim rngNextLine As Range:   Set rngNextLine = wsDest.Cells(Rows.Count, iCell.Column).End(xlUp).Offset(1, 0)
            rngNextLine.Value = iCell.Value
        Next iCell
        
        CurrentItem = CurrentItem + 1
    Wend
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
End Sub

Hope that helps,
~tigeravatar

That works great. Thanks!

It's interesting though. The code appears to be more complex that I had initially anticipated.