Excel programming- VERY VERY URGET

[kamakshi]

I have code here. from one excel to another excel import data from
column 22 with other excel to column 12 to other excel according to
that COMPANY NAME If anybody knows help me


Sub MoveSupporttoInv()
Application.ScreenUpdating = False
Dim i As Long
Dim mycompany
Dim contracttype
Dim CONTRACTTYPE1
Dim ORIGINALEXPIRATION
Dim TERMTYPE
Dim NOTICEPERIOD
Dim RENEWALINTERVAL
Dim IMPLEMENTAIONEXCEPTION
Dim CIBCLegalEntity
Dim Contractmanager
Dim businessunit
Windows("License & Support - 8.17.05").Activate ''Change to new
workbk name
'Sheets("License & support").Activate
For i = Range("a65536").End(xlUp).Row To 5 Step -1

mycompany = Cells(i, 1).Text
contracttype = Cells(i, 6).Text
CIBCLegalEntity = Cells(i, 5).Text
CONTRACTTYPE1 = Cells(i, 7).Text
ORIGINALEXPIRATION = Cells(i, 12).Text
TERMTYPE = Cells(i, 13).Text
NOTICEPERIOD = Cells(i, 14).Text
RENEWALINTERVAL = Cells(i, 15).Text
IMPLEMENTAIONEXCEPTION = Cells(i, 17).Text
Contractmanager = Cells(i, 21).Text
businessunit = Cells(i, 20).Text
Windows("MASTER").Activate ''CHANGE THIS TO NEW WKBOOK
On Error Resume Next
Range("A:A").Cells.Find(What:=mycompany, LookIn:=xlValues,
LookAt:=xlWhole).Select
If Err = 91 Then
Windows("License & support - 8.17.05").Activate ''Change to
new workbk name
ElseIf mycompany <> "" Then
ActiveCell.Offset(, 5).Value = contracttype
ActiveCell.Offset(, 6).Value = CONTRACTTYPE1
If ActiveCell.Offset(, 8).Text <> CIBCLegalEntity Then
ActiveCell.Offset(, 8).Value = CIBCLegalEntity
Else
ActiveCell.Offset(, 8).Value = CIBCLegalEntity
End If
ActiveCell.Offset(, 14).Value = ORIGINALEXPIRATION
ActiveCell.Offset(, 15).Value = TERMTYPE
ActiveCell.Offset(, 16).Value = NOTICEPERIOD
ActiveCell.Offset(, 17).Value = RENEWALINTERVAL
ActiveCell.Offset(, 20).Value = IMPLEMENTAIONEXCEPTION
ActiveCell.Offset(, 39).Value = Contractmanager
ActiveCell.Offset(, 40).Value = businessunit
Windows("License & support - 8.17.05").Activate ''Change to
new workbk name
End If
Windows("License & support - 8.17.05").Activate ''Change to new
workbk name
Next
End Sub

 

[Bob Phillips]

I haven't tested it just coded it but try this

Sub MoveSupporttoInv()
Application.ScreenUpdating = False
Dim i As Long
Dim mycompany
Dim contracttype
Dim CONTRACTTYPE1
Dim ORIGINALEXPIRATION
Dim TERMTYPE
Dim NOTICEPERIOD
Dim RENEWALINTERVAL
Dim IMPLEMENTAIONEXCEPTION
Dim CIBCLegalEntity
Dim Contractmanager
Dim businessunit
Dim oCell As Range

Windows("License & Support - 8.17.05").Activate ''Change to new workbk
Name
'Sheets("License & support").Activate
For i = Range("A" & Rows.Count).End(xlUp).Row To 5 Step -1
mycompany = Cells(i, 1).Text
contracttype = Cells(i, 6).Text
CIBCLegalEntity = Cells(i, 5).Text
CONTRACTTYPE1 = Cells(i, 7).Text
ORIGINALEXPIRATION = Cells(i, 12).Text
TERMTYPE = Cells(i, 13).Text
NOTICEPERIOD = Cells(i, 14).Text
RENEWALINTERVAL = Cells(i, 15).Text
IMPLEMENTAIONEXCEPTION = Cells(i, 17).Text
Contractmanager = Cells(i, 21).Text
businessunit = Cells(i, 20).Text
Windows("MASTER").Activate ''CHANGE THIS TO NEW WKBOOK
On Error Resume Next
Set oCell = Workbooks("MASTER").Range("A:A").Find(What:=mycompany, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If Not oCell Is Nothing Then
If mycompany <> "" Then
oCell.Offset(, 5).Value = contracttype
oCell.Offset(, 6).Value = CONTRACTTYPE1
oCell.Offset(, 8).Value = CIBCLegalEntity
oCell.Offset(, 14).Value = ORIGINALEXPIRATION
oCell.Offset(, 15).Value = TERMTYPE
oCell.Offset(, 16).Value = NOTICEPERIOD
oCell.Offset(, 17).Value = RENEWALINTERVAL
oCell.Offset(, 20).Value = IMPLEMENTAIONEXCEPTION
oCell.Offset(, 39).Value = Contractmanager
oCell.Offset(, 40).Value = businessunit
End If
End If
Windows("License & support - 8.17.05").Activate ''Change to new
workbk Name
Next
End Sub




--

HTH

RP
(remove nothere from the email address if mailing direct)