Hi Robert and anyone else who is willing to help out,

I tried Robert's suggestion above, but I guess due to my lack of VBA knowledge I did ot get very far. So I decided to have a different approach but this time I got stuck with the If/Elseif Statements. If anyone can sort me out with this, I think I am 90% there. I may get stuck again in the last part, but I will cry for help then.

Here is my Code which I think it will work once I sort out the if statements ( and add many more of them)

Thanks for your help and suggestions.

Talat




Sub PrintRoom()
     
   Application.ScreenUpdating = False
   
   Dim myRange      As String
   Dim InvNum        As Long     'Despatch Note Number
   Dim InvSheet      As Worksheet
   Dim PrintRmSheet  As Worksheet
   Dim NextRow       As Long     'the next available invoice row on the PrintRmSheet
   Dim oRow          As Long     'row number on PrintRmSheet
   Dim iRow          As Long     'row number on InvSheet
   Dim DestCol      As String    'Column Name on PrintRmSheet
   
   
   Set InvSheet = ThisWorkbook.Worksheets("INVOICE TEMPLATE")
   
   
    Workbooks.Open Filename:="G:\PUBS\PP-MS\INVOICES\PrintRmData.xlsx"
        
    Set PrintRmSheet = ActiveWorkbook.Worksheets("Sheet1")
   
   oRow = PrintRmSheet.UsedRange.Rows.Count + 1
   iRow = 20
 
      
    Do
     
    
        InvSheet.Range("K2").Copy  'DN Number
        PrintRmSheet.Cells(oRow, "A").PasteSpecial xlPasteValues
        InvSheet.Range("B6").Copy  'Section Name
        PrintRmSheet.Cells(oRow, "B").PasteSpecial xlPasteValues
       
        
      
      If InvSheet.Cells(iRow, "D") = "P4068EN" Then DestCol = "K"
      ElseIf InvSheet.Cells(iRow, "D") = "P4063EN" Then DestCol = "H"
      ElseIf InvSheet.Cells(iRow, "D") = "P4069MU" Then DestCol = "J"
 
      'Need to add more Else if conditions here
      
      End If
      InvSheet.Cells(iRow, "E").Copy
      PrintRmSheet.Cells(oRow, DestCol).PasteSpecial xlPasteValues
          
      
               
    
   
      iRow = iRow + 1
      'oRow = oRow + 1
   
   
   
   
   Loop Until IsEmpty(InvSheet.Cells(iRow, "D")) Or InvSheet.Cells(iRow, "D") = F
   
  
   
   
   Application.CutCopyMode = False
   ActiveWorkbook.Close True           'save changes and close
   
   Application.ScreenUpdating = True
     
End Sub