Option Explicit

Sub Test()
Dim oSht1 As Worksheet, oSht2 As Worksheet, vl, k#
Dim i As Long, jLastRow As Long
Dim R_data As Variant
Dim FinalRow, FinalColumn As Long
With ActiveWorkbook
For Each vl In .Worksheets
If vl.Name Like "380*" Then
Set oSht1 = .Sheets(vl.Name)
ElseIf vl.Name Like "Лист1" Then
Set oSht2 = .Sheets(vl.Name)
End If
Next
oSht1.Activate
Range("A1:D1").Select
Selection.Copy
Sheets("Лист1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Range("D3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Ошибки на " & Format$(Date, "dd.mm.yyyyг.")
Range("D3").Select
Selection.Font.Bold = True
Columns("B:B").NumberFormat = "@"

FinalRow = oSht1.Cells(Rows.Count, 1).End(xlUp).Row
FinalColumn = oSht1.Cells(1, Columns.Count).End(xlToLeft).Column
R_data = oSht1.Range(oSht1.Cells(1, 1), oSht1.Cells(FinalRow, FinalColumn))
With oSht2
jLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 2
.Cells(jLastRow, 4).Font.Bold = True
.Cells(jLastRow, 4).Value = "Латиница"
oSht1.Activate
For i = 2 To FinalRow
If R_data(i, 3) Like "*[A-Za-z]*" And R_data(i, 2) <> "0000000000" Then
R_data(i, FinalColumn) = Union(Range(Cells(i, 1), Cells(i, 4)), Range(Cells(i, 4), Cells(i, 18)))
End If

For k = 1 To Len(Cells(i, 3))
If Mid(R_data(i, 3), k, 1) Like "*[A-Za-z]*" Then
.Cells(jLastRow + 1, 3).Characters(Start:=k, Length:=1).Font.Color = -16776961
End If
Next
Next i
oSht2.Cells(jLastRow + 1, 1).Range(oSht2.Cells(1, 1), oSht2.Cells(FinalRow, 4)) = R_data
End With
End With
End Sub