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
Bookmarks