کد:
Sub copypaste()
FromRange = Cells(2, 13)
ToRange = Cells(2, 14)
SheetRange = Cells(2, 15)
If FromRange <> "" And ToRange <> "" And SheetRange <> "" And FromRange < ToRange Then
FindFrom = Range("A1:A2000").Find(FromRange).Row
FindTo = Range("A1:A2000").Find(ToRange).Row
For i = FindFrom To FindTo Step 1
Range("B" & i).FormulaR1C1 = "=VLOOKUP(RC[-1]," & SheetRange & "!C[-1]:C[10],COLUMN(),FALSE)"
Range("C" & i).FormulaR1C1 = "=VLOOKUP(RC[-2]," & SheetRange & "!C[-2]:C[9],COLUMN(),FALSE)"
Range("D" & i).FormulaR1C1 = "=VLOOKUP(RC[-3]," & SheetRange & "!C[-3]:C[8],COLUMN(),FALSE)"
Range("E" & i).FormulaR1C1 = "=VLOOKUP(RC[-4]," & SheetRange & "!C[-4]:C[7],COLUMN(),FALSE)"
Range("F" & i).FormulaR1C1 = "=VLOOKUP(RC[-5]," & SheetRange & "!C[-5]:C[6],COLUMN(),FALSE)"
Range("G" & i).FormulaR1C1 = "=VLOOKUP(RC[-6]," & SheetRange & "!C[-6]:C[5],COLUMN(),FALSE)"
Range("H" & i).FormulaR1C1 = "=VLOOKUP(RC[-7]," & SheetRange & "!C[-7]:C[4],COLUMN(),FALSE)"
Range("I" & i).FormulaR1C1 = "=VLOOKUP(RC[-8]," & SheetRange & "!C[-8]:C[3],COLUMN(),FALSE)"
Range("J" & i).FormulaR1C1 = "=VLOOKUP(RC[-9]," & SheetRange & "!C[-9]:C[2],COLUMN(),FALSE)"
Range("K" & i).FormulaR1C1 = "=VLOOKUP(RC[-10]," & SheetRange & "!C[-10]:C[1],COLUMN(),FALSE)"
Range("L" & i).FormulaR1C1 = "=VLOOKUP(RC[-11]," & SheetRange & "!C[-11]:C,COLUMN(),FALSE)"
Next i
End If
End Sub
علاقه مندی ها (Bookmarks)