How to copy sheet1 to sheet2

Question

I got two sheets,sheet1 contained all the information about the roster for a week for all employees,I need to copy information from sheet1 to sheet2 based on Employee ID as primary key In sheet2,I have only the employee ID and name is displayed. For instance,employee 21253,records of shift on MON should be displayed in day1-shift 1, TUE should be displayed in day2-shift1,WED should be displayed in day3-shift1 etc.SHift2 column should remain blank(skip this column) Sheet1

Sheet2:

My code is writted below:it does copy all the information but not in the format shown in sheet 2.

Sub transferSheet2()
Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim myname As String
lastrow1 = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lastrow1
myname = Sheets("Sheet1").Cells(i, "A").Value

Sheets("Sheet2").Activate
lastrow2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row

For j = 2 To lastrow2

If Sheets("Sheet2").Cells(j, "A").Value = myname Then
Sheets("Sheet1").Activate
'copy in sheet1 from column B to I
Sheets("Sheet1").Range(Cells(i, "B"), Cells(i, "I")).Copy
Sheets("Sheet2").Activate
'paste in sheet1 from column B to I
Sheets("Sheet2").Range(Cells(j, "B"), Cells(j, "I")).Select
ActiveSheet.Paste
End If

Next j
Next i
'insert new column
'Call insert_column_every_other

'insert headers
'Call Copy_Header
'Autofit columns

ThisWorkbook.Worksheets("Sheet2").Cells.EntireColumn.AutoFit
End Sub

Answer 1

Change ActiveSheet.Paste

To:-

ActiveSheet.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
             Operation:= xlNone, SkipBlanks:=False, Transpose:=False

The xlPasteValuesAndNumberFormats includes the formatting.