Hi,

Below is part of a code I have which pastes data repetitively down the sheet
for me.

Can anyone advise me how I could loop this or repeat it without having to
copy out this code for each department.

Also where it has Replacement "Other" I would like to put in a text box in
which the user can Identify the name of the department that is to be pasted
in.

Cheers Sue

Range("paste3").Select
Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
Sheets("Lookup").Select
Application.Goto Reference:="Item_Nos1"
Selection.Copy
Sheets("B V G").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveWorkbook.Names.Add Name:="paste4", RefersToR1C1:= _
"=OFFSET('B V G'!R1C1,'Lookup'!R4C5,0,'Lookup'! R1C6,3)"
Range("paste4").Offset(0, 1).Select
Selection.Replace What:="", Replacement:="Other", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False

Does the choice of department also affect the data you are looking up and
pasting? Without knowing more I can only give an outline of a solution, but
you could create a loop like this:

Dim DeptChoice as String

DeptChoice = InputBox("Enter the Department (enter 'done' when
finished):","SELECT DEPARTMENT")
While Not UCase(DeptChoice) = "DONE"
' you would want code here to check for valid input...
' Then put your code from below here to look up and paste your data
DeptChoice = InputBox("Department (enter 'done' when finished):","SELECT
DEPARTMENT")
Wend

HTH!

"SiouxieQ" wrote:

Hi,

Below is part of a code I have which pastes data repetitively down the sheet
for me.

Can anyone advise me how I could loop this or repeat it without having to
copy out this code for each department.

Also where it has Replacement "Other" I would like to put in a text box in
which the user can Identify the name of the department that is to be pasted
in.

Cheers Sue

Range("paste3").Select
Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
Sheets("Lookup").Select
Application.Goto Reference:="Item_Nos1"
Selection.Copy
Sheets("B V G").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveWorkbook.Names.Add Name:="paste4", RefersToR1C1:= _
"=OFFSET('B V G'!R1C1,'Lookup'!R4C5,0,'Lookup'! R1C6,3)"
Range("paste4").Offset(0, 1).Select
Selection.Replace What:="", Replacement:="Other", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False