【VBA】テーブル列を並び替えて別シートに高速でコピー貼り付けしたい

VBA

1Sub Copy_master() 2 '社員名簿をコピーして社員マスタに貼り付け 3 Application.ScreenUpdating = False 4 5 Dim wS1 As Worksheet 6 Dim wS2 As Worksheet 7 Dim LastRow As Long 8 9 'ワークシートを変数で宣言する 10 Set wS1 = Worksheets("現在の社員名簿") 11 Set wS2 = Worksheets("社員マスタ") 12 13 '最終行を取得 14 LastRow = wS1.Cells(Rows.Count, "A").End(xlUp).Row 15 16 '3行目以降をクリアする 17 wS2.Rows("3:" & Rows.Count).ClearContents 18 19 '値をコピーして貼り付ける 20 With wS1.Range("A2").CurrentRegion.Range("B2") 21 .Offset(1, 0).Resize(LastRow - 1, 1).Copy wS2.Range("A3") '社員番号 22 .Offset(1, 1).Resize(LastRow - 1, 1).Copy wS2.Range("G3") '支社 23 .Offset(1, 6).Resize(LastRow - 1, 1).Copy wS2.Range("EM3") '経歴 24 .Offset(1, 8).Resize(LastRow - 1, 1).Copy wS2.Range("J3") '役職名 25 .Offset(1, 10).Resize(LastRow - 1, 1).Copy wS2.Range("B3") '氏名 26 .Offset(1, 11).Resize(LastRow - 1, 1).Copy wS2.Range("C3") '氏名カナ 27 .Offset(1, 12).Resize(LastRow - 1, 1).Copy wS2.Range("R3") '生年月日 28 .Offset(1, 13).Resize(LastRow - 1, 1).Copy wS2.Range("AI3") '入社年月日 29 .Offset(1, 14).Resize(LastRow - 1, 1).Copy wS2.Range("EN3") 'メールアドレス 30 .Offset(1, 15).Resize(LastRow - 1, 1).Copy wS2.Range("S3") '学歴(学校名) 31 .Offset(1, 16).Resize(LastRow - 1, 1).Copy wS2.Range("T3") '学部・学科 32 .Offset(1, 17).Resize(LastRow - 1, 1).Copy wS2.Range("U3") '卒業年月 33 .Offset(1, 18).Resize(LastRow - 1, 1).Copy wS2.Range("W3") '大学卒業区分 34 .Offset(1, 19).Resize(LastRow - 1, 1).Copy wS2.Range("F3") '支社コード 35 .Offset(1, 20).Resize(LastRow - 1, 1).Copy wS2.Range("E3") '所属 36 .Offset(1, 21).Resize(LastRow - 1, 1).Copy wS2.Range("D3") '所属コード 37 .Offset(1, 22).Resize(LastRow - 1, 1).Copy wS2.Range("H3") 'クラス 38 .Offset(1, 23).Resize(LastRow - 1, 1).Copy wS2.Range("I3") '管理職F 39 .Offset(1, 24).Resize(LastRow - 1, 1).Copy wS2.Range("K3") '直間F 40 .Offset(1, 25).Resize(LastRow - 1, 1).Copy wS2.Range("L3") '社内外F 41 .Offset(1, 26).Resize(LastRow - 1, 1).Copy wS2.Range("M3") '基準内単価 42 .Offset(1, 27).Resize(LastRow - 1, 1).Copy wS2.Range("N3") '残業単価 43 .Offset(1, 28).Resize(LastRow - 1, 1).Copy wS2.Range("O3") '単価１ 44 .Offset(1, 29).Resize(LastRow - 1, 1).Copy wS2.Range("P3") '単価２ 45 .Offset(1, 30).Resize(LastRow - 1, 1).Copy wS2.Range("Q3") '単価３ 46 .Offset(1, 31).Resize(LastRow - 1, 1).Copy wS2.Range("V3") '大学卒業区分コード 47 .Offset(1, 32).Resize(LastRow - 1, 11).Copy wS2.Range("X3") '実務開始年月～所属営業所 48 .Offset(1, 43).Resize(LastRow - 1, 107).Copy wS2.Range("AJ3") '退職年月日～経歴 49 End With 50 51 'セル範囲を線で囲む 52 wS2.Range("A3:EN" & LastRow).Borders.LineStyle = xlLineStyleNone 53 54 'A1セルにタイトルをつける 55 wS2.Range("a1") = "今日現在の社員マスタ" 56 57 Application.ScreenUpdating = True 58 59End Sub