Sub SynthesisGathered()
Dim myRange As Range
Dim searchRange As Range
Dim cmd
Sheets("Synthesis").Unprotect
Range("D3:GU19").ClearContents
For i = 4 To 203
Columns(i).Hidden = False
Next i
If Sheets("Home").Range("E16") = Sheets("Home").Range("B35") Then
With Sheets("ExistingFiles"): Set searchRange = .Range("D2").Resize(.Range("D65536").End(xlUp).Row - 1, 1): End With
Else
Set searchRange = Range("D2").Resize(1, Range("GU2").End(xlToLeft).Column - 4)
End If
Dim cpt As Long
cpt = -2
For Each cell In searchRange
If cell <> "" Then
cpt = cpt + 2
doc = "'" & ActiveWorkbook.Path & "\[" & cell & ".xls]KFdb'!"
Set myRange = Range("D2").Offset(0, cpt)
For i = 1 To 17
myRange.Offset(i, 0) = ExecuteExcel4Macro(doc & "R" & i & "C1")
myRange.Offset(i, 1) = ExecuteExcel4Macro(doc & "R" & i & "C2")
Next i
End If
Next cell
Dim l, t, w, h
For Each sh In Sheets("Synthesis").Shapes
If Left(sh.Name, Len("BTT")) = "BTT" Then sh.Delete
Next sh
For i = 4 To 203
Columns(i).Hidden = Cells(4, i) = ""
If Cells(3, i) <> "" Then
l = Cells(3, i).Left + 1
t = Cells(3, i).Top
h = Cells(3, i).Height
w = Cells(3, i).Width + Cells(3, i + 1).Width - 2
Set cmd = Sheets("Synthesis").Buttons.Add(l, t, w, h)
cmd.Name = "BTT" & i
cmd.OnAction = "'BoutonAction """ & i & """'"
cmd.Characters.Text = Cells(3, i)
End If
Next i
Sheets("Synthesis").Protect DrawingObjects:=False, Contents:=True, Scenarios:=True
End Sub