Copy values and paste to matching worksheet name - excel

Question

I am trying to make VBA to copy data and paste to matching worksheet name.
"Setting" Worksheet will have all mixed data of item types.
With VBA, copy & paste values on A & D columns to matching worksheet name.
VBA code will go through entire A7 -> lastrow
worksheet name is based on the item types.
Right now, I am stuck on this part - setting supplier as dynamic worksheet
Below is the issue area: "out of range"
For i = 7 To lastrow1
'setting spl as the value of the item type
spl = Cells(i, "A").Value
'setting supplier as the worksheet name
Set supplier = Sheets(spl)
Below is the entire VBA code:
I have found an existing code, and had been tweaking to fit my usage.
Sub Copy_Data()
Dim lastrow1 As Long, i As Long, auxRow As Long, offsetRow As Long
Dim spl As String
Dim supplier As Worksheet
Set ws = Sheets("SETTING")
lastrow1 = ws.Columns("A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For i = 7 To lastrow1
'setting spl as the value of the item type
spl = Cells(i, "A").Value
'setting supplier as the worksheet name
Set supplier = Sheets(spl)
auxRow = supplier.Columns("A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
If auxRow > 1 Then auxRow = auxRow + 1
If auxRow = 1 Then auxRow = offsetRow
supplier.Cells(auxRow, "A") = ws.Cells(i, "A")
supplier.Cells(auxRow, "B") = ws.Cells(i, "D")
Next i
End Sub
Thank you all in an advance.
I have tried to define the worksheet to have dynamic value - based on item type on column A.
But keep receiving 'out of range' when setting the worksheet.

Answer 1

"out of range" because you are opening one sheet from the list. you need to open setting sheet when you run this code.
Another thing don't use Find function
ws.Columns("A").Find("*", searchorder:=xlByRows, earchdirection:=xlPrevious).Row
because returns either of the following outcomes:
If a match is found, the function returns the first cell where the value is located.
If a match is not found, the function returns nothing.
That's will give you error because you define lastrow1 and auxRow as long
instead use this
lastrow1 = ws.Range("A" & Rows.Count).End(xlUp).Row
Try to use this code
Sub Copy_Data()
Dim lastrow1 As Long, i As Long, auxRow As Long, offsetRow As Long
Dim spl As String
Dim supplier As Worksheet
Dim ws As Worksheet
Set ws = Sheets("SETTING")
lastrow1 = ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 7 To lastrow1
'setting spl as the value of the item type
spl = Cells(i, "A").Value
'setting supplier as the worksheet name
Set supplier = Sheets(spl)
auxRow = supplier.Range("A" & Rows.Count).End(xlUp).Row + 1
supplier.Cells(auxRow, "A") = ws.Cells(i, "A")
supplier.Cells(auxRow, "B") = ws.Cells(i, "D")
Next i
End Sub

Answer 2

Please, test the next code. If follows the scenario I tried describing in my above comment: place the range to be processed in an array, iterate it and place the necessary data in the dictionary, then drop the processed result in each appropriate sheet. Working only in memory, until dropping the processed result makes it very fast, even for large data:
Sub distributeIssues()
Dim shS As Worksheet, lastR As Long, wb As Workbook, arr, arrIt, arrFin, i As Long
Dim key, dict As Object
Set wb = ThisWorkbooks
Set shS = wb.Sheets("SETTING")
lastR = shS.Range("A" & shS.rows.count).End(xlUp).row 'last row
arr = shS.Range("A7:D" & lastR).Value2 'place the range in an array for faster iteration/processing
'place the range to be processed in dictionary:
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arr) 'iterate between the array rows
If Not dict.Exists(arr(i, 1)) Then 'if key does not exist
dict.Add arr(i, 1), Array(arr(i, 4)) 'create it and place the value in D:D as array item
Else
arrIt = dict(arr(i, 1)) 'place the item content in an array
ReDim Preserve arrIt(UBound(arrIt) + 1) 'extend the array with an element
arrIt(UBound(arrIt)) = arr(i, 4) 'place value from D:D in the last element
dict(arr(i, 1)) = arrIt 'place back the array as dictionary item
End If
Next i
'Stop
'drop the necessary value in the appropriate sheet:
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For Each key In dict
With wb.Worksheets(key).Range("B9").Resize(UBound(dict(key)) + 1, 1)
.Value = Application.Transpose(dict(key))
.Offset(, -1).Value = key
End With
Next key
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "Ready..."
End Sub
Please, send some feedback after testing it.
If something not clear enough, do not hesitate to ask for clarifications.
The items can be in any order. No necessary to be sorted...