Option Explicit
Sub bb()
Dim FilesToOpen
Dim x As Integer
Dim importWB As Workbook, wb As Workbook
Set wb = ActiveWorkbook
Application.ScreenUpdating = False 'отключаем обновление экрана для скорости
'вызываем диалог выбора файлов для импорта
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="All files (*.*), *.*", _
MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "Не выбрано ни одного файла!"
Exit Sub
End If
'проходим по всем выбранным файлам
x = 1
While x <= UBound(FilesToOpen)
Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
importWB.Sheets().Copy After:=wb.Sheets(wb.Sheets.Count)
importWB.Close savechanges:=False
x = x + 1
Wend
Application.ScreenUpdating = True
'
' Светофор Макрос
'
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("2:2").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("2:2").Select
Columns("A:A").ColumnWidth = 37
Columns("B:B").Select
Selection.ColumnWidth = 12
Columns("D:G").Select
Selection.ColumnWidth = 24
Columns("H:H").Select
Selection.ColumnWidth = 15
Range("A2").Select
ActiveCell.FormulaR1C1 = "ФИО"
Range("B2").Select
ActiveCell.FormulaR1C1 = "Таб.№"
Range("C3").Select
Selection.Copy
Range("A1").Select
ActiveSheet.Paste
Columns("B:G").Select
Selection.NumberFormat = "General"
Selection.Value = Selection.Value
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1:F2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Selection.Font.Bold = True
Columns("C:F").Select
Selection.FormatConditions.AddIconSetCondition
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.ReverseOrder = False
.ShowIconOnly = False
.IconSet = ActiveWorkbook.IconSets(xl3TrafficLights1)
End With
With Selection.FormatConditions(1).IconCriteria(2)
.Type = xlConditionValueNumber
.Value = 0.5
.Operator = 7
End With
With Selection.FormatConditions(1).IconCriteria(3)
.Type = xlConditionValueNumber
.Value = 0.8
.Operator = 7
End With
Range("ТаблицаСВычислениями").Copy Cells(ActiveSheet.UsedRange.Rows.Count + 2, 1)
End Sub