Hi Everyone,

I would like to modify the following code to have it distribute the entries over several worksheets. The code basically takes the "Import" entries, adjusts them based on the "Adjustment Table" and then puts only the adjusted entries in the "Export" tab. I would like to have the Export entries be separated into their own worksheets, with the name of the worksheet based on the Name of the Adjustment.

Can someone help me with this? I've also provided the link to the original solved thread.

Thanks!

Option Explicit

Sub copyData()
Dim wsI As Worksheet, wsAT As Worksheet, wsEx As Worksheet
Dim matchRng As Variant
Dim k As Long, adjV As Double
Dim resRng As Range, rs As Range
Set wsI = Worksheets("Import")
Set wsAT = Worksheets("Adjustment Table")
Set wsEx = Worksheets("Export")
wsEx.Range("A2").Resize(wsEx.Cells(Rows.Count, "A").End(xlUp).Row, 5).Clear
matchRng = Application.Index(Application.Transpose(wsAT.Range("A4:B" & wsAT.Cells(Rows.Count, "B").End(xlUp).Row)), 0, 0)
For k = LBound(matchRng, 2) To UBound(matchRng, 2)
    Set resRng = Find_Range(matchRng(1, k), wsI.Columns("D"), xlValues, xlWhole)
    If Not resRng Is Nothing Then
        For Each rs In resRng
            wsI.Range("A" & rs.Row).Resize(, 5).Copy wsEx.Range("A" & wsEx.Cells(Rows.Count, "A").End(xlUp).Row + 1)
            adjV = wsEx.Range("E" & wsEx.Cells(Rows.Count, "E").End(xlUp).Row)
            adjV = adjV + (adjV * matchRng(2, k))
            wsEx.Range("E" & wsEx.Cells(Rows.Count, "E").End(xlUp).Row) = adjV
        Next
    End If
Next
Call sortData(wsEx)
End Sub

Sub sortData(ws As Worksheet)
Dim lrow As Long
    ws.Select
    lrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    ws.Range("A1:E" & lrow).Select
    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add Key:=Range("D2:D" & lrow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ws.Sort.SortFields.Add Key:=Range("C2:C" & lrow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ws.Sort.SortFields.Add Key:=Range("B2:B" & lrow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ws.Sort
        .SetRange Range("A1:E" & lrow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With Worksheets("Export")
    .Range("a:a").NumberFormat = "000#"
    .Range("e:e").NumberFormat = "0"
    .Range("B:B").NumberFormat = "yyyy-mm-dd"
    .Cells.EntireColumn.AutoFit
    End With
End Sub
http://www.excelforum.com/excel-prog...56#post3058156