Public OriginRng As Range, BrandRng As Range
Sub Copy2Sheets()
Dim src As Worksheet
Dim trg As Worksheet
Dim LastRow As Long, rcount As Long, srow As Long, lrow As Long
Application.ScreenUpdating = False
Set src = ThisWorkbook.Worksheets("tt")
srow = 2
With src
.Activate
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set srcRng = .Range("A1:A" & LastRow)
shtname = .Cells(srow, "A") ' First sheet
rcount = WorksheetFunction.CountIf(srcRng, shtname)
lrow = srow + rcount - 1
Set trg = ThisWorkbook.Worksheets(shtname)
hdr = Array("Item", "Brand", "Origin", "Qty")
trg.Range("A1").Resize(1, 4) = hdr
.Range("H" & srow & ":H" & lrow).Copy Destination:=trg.Range("A2")
.Range("E" & srow & ":E" & lrow).Copy Destination:=trg.Range("B2")
.Range("C" & srow & ":C" & lrow).Copy Destination:=trg.Range("C2")
.Range("B" & srow & ":B" & lrow).Copy Destination:=trg.Range("D2")
Set BrandRng = trg.Range("B2:B" & rcount + 1)
Set OriginRng = trg.Range("C2:C" & rcount + 1)
Call Get_Origin
'************************************************************************
hdr = Array("Sr", "Item Code", "Accepted Quantity")
srow = lrow + 1
shtname = .Cells(srow, "A") ' Second sheet
srow = srow + 1
rcount = WorksheetFunction.CountIf(srcRng, shtname) - 1
lrow = srow + rcount - 1
Set trg = ThisWorkbook.Worksheets(shtname)
trg.Range("A1").Resize(1, 3) = hdr
.Range("B" & srow & ":B" & lrow).Copy Destination:=trg.Range("A2")
.Range("C" & srow & ":C" & lrow).Copy Destination:=trg.Range("B2")
.Range("F" & srow & ":F" & lrow).Copy Destination:=trg.Range("C2")
For i = 1 To rcount
trg.Range("B" & i + 1) = trg.Range("B" & i + 1) & " JAP"
trg.Range("C" & i + 1) = Replace(trg.Range("C" & i + 1), "Unit", "")
Next i
'************************************************************************
hdr = Array("Sr", "Descriptione", "Production", "Qty")
srow = lrow + 1
shtname = .Cells(srow, "A") ' Third Sheet
srow = srow + 1
rcount = WorksheetFunction.CountIf(srcRng, shtname) - 1
lrow = srow + rcount - 1
Set trg = ThisWorkbook.Worksheets(shtname)
trg.Range("A1").Resize(1, 4) = hdr
.Range("E" & srow & ":E" & lrow).Copy Destination:=trg.Range("A2")
.Range("D" & srow & ":D" & lrow).Copy Destination:=trg.Range("B2")
.Range("B" & srow & ":B" & lrow).Copy Destination:=trg.Range("C2")
.Range("C" & srow & ":C" & lrow).Copy Destination:=trg.Range("D2")
Set BrandRng = trg.Range("B2:B" & rcount + 1)
Set OriginRng = trg.Range("C2:C" & rcount + 1)
Call Get_Origin
End With
Application.ScreenUpdating = True
End Sub
Sub Get_Origin()
Dim a, n As Integer, i As Integer, c As Range, Origin As String
a = Range("Short")
n = 0
For Each c In OriginRng
n = n + 1
For i = 1 To 7
BrandRng(n) = Replace(BrandRng(n, 1), a(i, 1), "")
Next i
Origin = Application.WorksheetFunction.VLookup(c, Range("liss"), 2, False)
BrandRng(n, 1).Value = Trim(BrandRng(n, 1).Value) & " " & Origin
Next c
End Sub
I added POLAND/POL to "LISS" table
Bookmarks