K
Kanmi
Please can anybody help me? I want this scripts not to create a new sheet but
insert the information to destination.xls on sheet "WPS Detail Dates". It
working by creating new sheet but i want the information on existing sheet
""WPS Detail Dates". and whenever i edit then it pop up run-time error.
please advice. Thanks Appreciate your time
Sub CreateMaster()
Set Source = Workbooks("Source.xls")
Set SourceSht = Source.Sheets("Sheet1")
'Set SourceSht = Sheets("Sheet1")
Set Dest = Workbooks("Destination.xls")
'Set Dest = ThisWorkbook
'create new worksheet
With Dest
Set DestSht = .Sheets.Add(after:=.Sheets(.Sheets.Count))
DestSht.Name = "Master"
End With
With DestSht
SourceSht.Columns("C:C").Copy _
Destination:=.Columns("C:C")
Lastrow = .Range("C" & Rows.Count).End(xlUp).Row
.Range("C1:C" & Lastrow).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("B1"), _
Unique:=True
'delete temporay column C
.Columns("C").Delete
.Range("A1") = "SALES"
.Range("B1") = "ID"
.Range("C1") = "Employee"
.Range("D1") = "Hire Date"
.Range("E1") = "Manager"
.Range("F1") = "Reg"
.Range("G1") = "Title"
Lastrow = .Range("B" & Rows.Count).End(xlUp).Row
For RowCount = 2 To Lastrow
ID = .Range("B" & RowCount)
With SourceSht
Set c = .Columns("C").Find(what:=ID, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox ("Cannot find ID : " & ID)
Else
Sales = "N/A"
Reg = "N/A"
Employee = .Range("A" & c.Row)
HireDate = .Range("D" & c.Row)
Title = .Range("E" & c.Row)
Manager = .Range("G" & c.Row)
End If
End With
If Not c Is Nothing Then
.Range("A" & RowCount) = Sales
.Range("C" & RowCount) = Employee
.Range("D" & RowCount) = HireDate
.Range("E" & RowCount) = Manager
.Range("F" & RowCount) = Reg
.Range("G" & RowCount) = Title
Else
MsgBox ("Error : Count not find ID : " & ID)
End If
Next RowCount
End With
End Sub
Sub UpdateMaster()
Set Source = Workbooks("Source.xls")
Set SourceSht = Source.Sheets("Sheet1")
'Set SourceSht = Sheets("Sheet1")
Set Dest = Workbooks("Destination.xls")
'Set Dest = ThisWorkbook
Set DestSht = Dest.Sheets("Master")
With DestSht
Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = Lastrow + 1
End With
With SourceSht
Lastrow = .Range("C" & Rows.Count).End(xlUp).Row
For RowCount = 2 To Lastrow
Sales = "N/A"
Reg = "N/A"
ID = .Range("C" & RowCount)
Employee = .Range("A" & RowCount)
HireDate = .Range("D" & RowCount)
Title = .Range("E" & RowCount)
Manager = .Range("G" & RowCount)
With DestSht
Set c = .Columns("B").Find(what:=ID, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
DataRow = NewRow
NewRow = NewRow + 1
.Range("B" & DataRow) = ID
Else
DataRow = c.Row
End If
.Range("A" & DataRow) = Sales
.Range("C" & DataRow) = Employee
.Range("D" & DataRow) = HireDate
.Range("E" & DataRow) = Manager
.Range("F" & DataRow) = Reg
.Range("G" & DataRow) = Title
End With
Next RowCount
End With
End Sub
insert the information to destination.xls on sheet "WPS Detail Dates". It
working by creating new sheet but i want the information on existing sheet
""WPS Detail Dates". and whenever i edit then it pop up run-time error.
please advice. Thanks Appreciate your time
Sub CreateMaster()
Set Source = Workbooks("Source.xls")
Set SourceSht = Source.Sheets("Sheet1")
'Set SourceSht = Sheets("Sheet1")
Set Dest = Workbooks("Destination.xls")
'Set Dest = ThisWorkbook
'create new worksheet
With Dest
Set DestSht = .Sheets.Add(after:=.Sheets(.Sheets.Count))
DestSht.Name = "Master"
End With
With DestSht
SourceSht.Columns("C:C").Copy _
Destination:=.Columns("C:C")
Lastrow = .Range("C" & Rows.Count).End(xlUp).Row
.Range("C1:C" & Lastrow).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("B1"), _
Unique:=True
'delete temporay column C
.Columns("C").Delete
.Range("A1") = "SALES"
.Range("B1") = "ID"
.Range("C1") = "Employee"
.Range("D1") = "Hire Date"
.Range("E1") = "Manager"
.Range("F1") = "Reg"
.Range("G1") = "Title"
Lastrow = .Range("B" & Rows.Count).End(xlUp).Row
For RowCount = 2 To Lastrow
ID = .Range("B" & RowCount)
With SourceSht
Set c = .Columns("C").Find(what:=ID, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox ("Cannot find ID : " & ID)
Else
Sales = "N/A"
Reg = "N/A"
Employee = .Range("A" & c.Row)
HireDate = .Range("D" & c.Row)
Title = .Range("E" & c.Row)
Manager = .Range("G" & c.Row)
End If
End With
If Not c Is Nothing Then
.Range("A" & RowCount) = Sales
.Range("C" & RowCount) = Employee
.Range("D" & RowCount) = HireDate
.Range("E" & RowCount) = Manager
.Range("F" & RowCount) = Reg
.Range("G" & RowCount) = Title
Else
MsgBox ("Error : Count not find ID : " & ID)
End If
Next RowCount
End With
End Sub
Sub UpdateMaster()
Set Source = Workbooks("Source.xls")
Set SourceSht = Source.Sheets("Sheet1")
'Set SourceSht = Sheets("Sheet1")
Set Dest = Workbooks("Destination.xls")
'Set Dest = ThisWorkbook
Set DestSht = Dest.Sheets("Master")
With DestSht
Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = Lastrow + 1
End With
With SourceSht
Lastrow = .Range("C" & Rows.Count).End(xlUp).Row
For RowCount = 2 To Lastrow
Sales = "N/A"
Reg = "N/A"
ID = .Range("C" & RowCount)
Employee = .Range("A" & RowCount)
HireDate = .Range("D" & RowCount)
Title = .Range("E" & RowCount)
Manager = .Range("G" & RowCount)
With DestSht
Set c = .Columns("B").Find(what:=ID, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
DataRow = NewRow
NewRow = NewRow + 1
.Range("B" & DataRow) = ID
Else
DataRow = c.Row
End If
.Range("A" & DataRow) = Sales
.Range("C" & DataRow) = Employee
.Range("D" & DataRow) = HireDate
.Range("E" & DataRow) = Manager
.Range("F" & DataRow) = Reg
.Range("G" & DataRow) = Title
End With
Next RowCount
End With
End Sub