Copy specific columns to another closed file

[sofas]

Welcome. I want to copy certain columns to another closed file. Use this code. It works fine, but it shows strange symbols in column 8. I don't know why

sub copy


On Error Resume Next


    Dim WB As Workbook, WS As Worksheet, SH As Worksheet


    Dim arr As Variant, i As Variant, cr As Variant, j As Long


    Dim lr As Long


    Set SH = ThisWorkbook.Worksheets("sh1")


    Set WB = Workbooks.Open(ThisWorkbook.Path & "\" & "sh2.xlsm")


    Set WS = WB.Worksheets(SH.Range("D2").Value)


    arr = SH.Range("A5:F" & SH.Cells(Rows.Count, 1).End(xlUp).Row).Value2

    cr = Array(2, 6, 8, 7)


    lr = WS.Cells(Rows.Count, 4).End(xlUp).Row + 1

    For Each i In Array(2, 4, 5, 8)


        WS.Cells(lr, cr(j)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , i)


        j = j + 1

    Next i


    WB.Close Savechanges:=True

End Sub[/CODE]

 

[sofas]

Sub Copy_Values()

  Dim ws1 As Worksheet, ws2 As Worksheet

  Dim aRws As Variant, aCols As Variant

  Dim lr As Long

 

  'I want to copy the following columns to a closed file

  'starting row 2

  Const ColsOfInterest As String = "1 6 9 14 17 "

  Set ws1 = ActiveSheet
  Set ws2 = Workbooks.Open(ThisWorkbook.Path & "\" & "sh2.xlsm")

  'With the possibility of specifying the sheet, the name of the target sheet in cell d2

  'copy

Sheet Name = ActiveSheet.Range("d2").Value

specific Columns

'"12 13 14 18 23 "

 ' starting row 6

End Sub