Copy and paste selected data without duplicates

[tmdgus]

Hi, I am new to VBA and need some help with some of the procedures I would like to automate.
I have two excel files to work on - employee and contract data.
Basically, I need to find employees who end their contracts in the current month that I open the file. (For example, if I open the file in August, I need to find employee data who are ending their contract in August). Then, I need to copy the selected data and paste them onto another file, called contract data.

I have completed both identifying and copy+paste, but it doesn't meet some of the requirements I want to apply in my file. I will put my code below.
The code below highlights rows of employee data whose employment contract expires within a month.

Sub HighlightCalc()
   Dim i As Range
   For Each i In Range("K2:K65565") '// K is the column that contains contract expiry date
      If IsDate(i) Then
         If Month(i) = Month(Now) Then
            Rows(i.Row).Interior.Color = RGB(255,255,91)
            Rows(i.Row).Font.Bold = True
         End If
      End If
   Next i
End Sub

The code below is when I transfer a selected row to another file called Contract Data

Private Sub CommandButton1_Click()
Dim wb As Workbook
ThisWorkbook.Worksheets("Sheet1").Rows(2).Select    '//Question 1: How do I select rows that I have previously highlighted above?
Selection.Copy

Set wb = Workbooks.Open("file address, didn't put the real address")
wb.Worksheets("Sheet1").Activate
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Cells(lastrow + 1, 1).Select
ActiveSheet.Paste.     '//Question 2: Is there any way that I can only copy "new" data and paste them? Every time I run this Macro, the same data is pasted.
'//Any suggestions on copying data to other files without duplicates?
'//Question 3: Can I only copy selected cells and paste them onto the selected places?
ActiveWorkbook.Save
ActiveWorkbook.Close savechanges = True

Set wb = Nothing
ThisWorkbook.Worksheets("Sheet1").Activate
ThisWorkbook.Worksheets("Sheet1").Cells(1,1).Select
Application.CutCopyMode = False

I have included some questions in the code.
To explain them further, when I copy the data from the Employee file to the Contract File, I do not want to copy the exact same data multiple times.
There is a column that I made for a unique identifier(column A), so I guess there might be a way to do this with it, but I am still clueless about how to do so, as I am not familiar with VBA yet.
I also do not know how to select the highlighted data to copy them to the Contract file.
Most importantly, when copying data, I only want some data to be copied, not all. (For example, I want to copy the name of employees and their positions, but not their addresses or phone number).
When pasting data, I want to paste them onto their allocated cell area.

Can anyone please help me with my VBA? I am new to this and need help ASAP

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim FTws As Worksheet, PTws As Worksheet, srcWS As Worksheet
    Set FTws = ThisWorkbook.Sheets("Contract(Full-Time)")
    Set PTws = ThisWorkbook.Sheets("Contract(Part-Time)")
    Set srcWS = ThisWorkbook.Sheets("Staff_Info")
    Dim lastRow As Long, i As Long, header As Range, x As Long
    lastRow = srcWS.Range("L" & srcWS.Rows.Count).End(xlUp).Row
    With srcWS
        .Range("A2").CurrentRegion.AutoFilter Field:=12, Criteria1:=xlFilterThisMonth, Operator:=xlFilterDynamic
        .Range("A2").CurrentRegion.AutoFilter Field:=7, Criteria1:="Monthly"
        With .Range("A:A,B:B,C:C,D:D,F:F,G:G,H:H,I:I,L:L")
            For i = 1 To .Areas.Count
                x = .Areas(i).Column
                Set header = FTws.Rows(1).Find(.Areas(i).Cells(2), LookIn:=xlValues, lookat:=xlWhole)
                If Not header Is Nothing Then
                    Intersect(srcWS.Range(srcWS.Cells(3, x), srcWS.Cells(lastRow, x)), srcWS.AutoFilter.Range).Copy FTws.Cells(FTws.Rows.Count, header.Column).End(xlUp).Offset(1, 0)
                End If
            Next i
        End With
        .Range("A2").CurrentRegion.AutoFilter Field:=12, Criteria1:=xlFilterThisMonth, Operator:=xlFilterDynamic
        .Range("A2").CurrentRegion.AutoFilter Field:=7, Criteria1:="Hourly", Operator:=xlOr, Criteria2:="Daily"
        With .Range("A:A,B:B,C:C,D:D,F:F,G:G,H:H,I:I,L:L")
            For i = 1 To .Areas.Count
                x = .Areas(i).Column
                Set header = PTws.Rows(1).Find(.Areas(i).Cells(2), LookIn:=xlValues, lookat:=xlWhole)
                If Not header Is Nothing Then
                    Intersect(srcWS.Range(srcWS.Cells(3, x), srcWS.Cells(lastRow, x)), srcWS.AutoFilter.Range).Copy PTws.Cells(PTws.Rows.Count, header.Column).End(xlUp).Offset(1, 0)
                End If
            Next i
        End With
    End With
    srcWS.Range("A2").AutoFilter
    Application.ScreenUpdating = True
    FTws.Range("a2:t65565").RemoveDuplicates Columns:=1, header:=xlNo
End Sub

 

[tmdgus]

Hi, Thank you so much for your help!!
Everything works perfectly except that Column L of Sheet1 isn't pasted to Column H of Sheet2.
Do you have any ideas on how to fix this issue??
Thank you for your help so far! I really appreciate it

 

[tmdgus]

This is the result table(sheet2) when I run CopyData() function.
As you can see data are pasted well, except column H, contract start date.
Could you please help me how to paste column L of sheet1 to column H of sheet2?
Thank you!!

Employment_Contract.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	Staff Number	Contract Date	(Mr./Ms.)	Last Name	First Name	HKID	Position	Contract Start Date	Contract End Date	Months	Probation	Contract Start Date	Probation End Date	Working Location	Working Hour	Contract Type	Salary	Annual Leave	Sick Leave	Holiday
2	PEOCL22001		Ms.	Lam	Ka Ho	B7894561	Marketing Intern									Monthly	HKD 65
3	PEOCL22004		Mr.	Chan	Pui Shan	E7539566	Finance Intern									Monthly	HKD 500
4	PEOCL22009		Mr.	Lee	Xiao Yu	K9856213	Manager									Monthly	HKD 360
Contract(Full-Time)

Cells with Data Validation
Cell	Allow	Criteria
J1	List	3,6,9,12
K1	List	0,3,6
N1	List	You will be working in the office or a place designated by the Company or the Company’s designated client.
O1	List	Monday to Friday 9:00 a.m. – 6:00 p.m. (Subject to the company’s requirements and mutual agreement. Actual working days may change if needed)
R1	List	You will be entitled to annual leave benefits in accordance with the provisions under the Hong Kong Employment Ordinance.
S1	List	You will be entitled to sick leave benefits in accordance with the provisions under the Hong Kong Employment Ordinance.
T1	List	You will be entitled to public holidays in accordance with the provisions under the Hong Kong Employment Ordinance.,You will be entitled to Statutory Holidays in accordance with the provisions under the Hong Kong Employment Ordinance.
C2:C4	List	Mr. ,Ms.
F2:F4	Text length	=8
P2:P4	List	Daily,Hourly,Monthly

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim FTws As Worksheet, PTws As Worksheet, srcWS As Worksheet
    Set FTws = ThisWorkbook.Sheets("Contract(Full-Time)")
    Set PTws = ThisWorkbook.Sheets("Contract(Part-Time)")
    Set srcWS = ThisWorkbook.Sheets("Staff_Info")
    Dim lastRow As Long, i As Long, header As Range, x As Long
    lastRow = srcWS.Range("L" & srcWS.Rows.Count).End(xlUp).Row
    With srcWS
        .Range("A2").CurrentRegion.AutoFilter Field:=12, Criteria1:=xlFilterThisMonth, Operator:=xlFilterDynamic
        .Range("A2").CurrentRegion.AutoFilter Field:=7, Criteria1:="Monthly"
        With .Range("A:A,B:B,C:C,D:D,F:F,G:G,H:H,I:I")
            For i = 1 To .Areas.Count
                x = .Areas(i).Column
                Set header = FTws.Rows(1).Find(.Areas(i).Cells(2), LookIn:=xlValues, lookat:=xlWhole)
                If Not header Is Nothing Then
                    Intersect(srcWS.Range(srcWS.Cells(3, x), srcWS.Cells(lastRow, x)), srcWS.AutoFilter.Range).Copy FTws.Cells(FTws.Rows.Count, header.Column).End(xlUp).Offset(1, 0)
                End If
            Next i
            srcWS.AutoFilter.Range.Offset(1).Columns(12).Copy FTws.Cells(FTws.Rows.Count, "H").End(xlUp).Offset(1)
        End With
        .Range("A2").CurrentRegion.AutoFilter Field:=12, Criteria1:=xlFilterThisMonth, Operator:=xlFilterDynamic
        .Range("A2").CurrentRegion.AutoFilter Field:=7, Criteria1:="Hourly", Operator:=xlOr, Criteria2:="Daily"
        With .Range("A:A,B:B,C:C,D:D,F:F,G:G,H:H,I:I,L:L")
            For i = 1 To .Areas.Count
                x = .Areas(i).Column
                Set header = PTws.Rows(1).Find(.Areas(i).Cells(2), LookIn:=xlValues, lookat:=xlWhole)
                If Not header Is Nothing Then
                    Intersect(srcWS.Range(srcWS.Cells(3, x), srcWS.Cells(lastRow, x)), srcWS.AutoFilter.Range).Copy PTws.Cells(PTws.Rows.Count, header.Column).End(xlUp).Offset(1, 0)
                End If
            Next i
        End With
    End With
    srcWS.Range("A2").AutoFilter
    Application.ScreenUpdating = True
    FTws.Range("a2:t65565").RemoveDuplicates Columns:=1, header:=xlNo
End Sub