Need optimization on Macro that Open too many files

Hi, i have a macro that open all the files listed on the column A, and extract the information on the last non empty cell on column H on those files, the problem is that when i run it, after like 13 files my excel just crash, that is why i need some optimization to make my macro run smoother.

Sub Asignar()

Dim aux As Single
Dim x As Integer
Dim VarArchivos(1 To 100) As String
x = 1
Worksheets("Sheet1").Activate
Worksheets("Sheet1").Range("A1").Activate
ActiveCell.Range("A1").Activate ‘fill the array with the names of the files.
Do Until ActiveCell.Value = “XXXXXXXXXX" ‘ the last non-empty cell on the column A is “XXXXXXXXXX”
VarArchivos(x) = ActiveCell.Value
ActiveCell.Offset(1, 0).Activate
x = x + 1
Loop
For i = 1 To (x - 1) ' Open all the files on the array and extract the information
Path = Application.ActiveWorkbook.Path
Workbooks.Open (Path & "/" & VarArchivos(i) & ".xlsx")
Worksheets("C.C.").Activate
Worksheets("C.C.").Range("A1").Activate
'Selection.End(xlDown).Select
VarArchivos(i) = ActiveCell.Value
ActiveWorkbook.Close savechanges:=False
Next i
Worksheets("Sheets1").Activate
Worksheets("Sheets1").Range("B1").Activate
For i = 1 To (x - 1) ‘Fill the column B with he information in the Array.
ActiveCell.Value = VarArchivos(i)
ActiveCell.Offset(1, 0).Activate
Next i
End Sub

Thanks... I just made some changes to your code and it still crashes but i found that the problem it's that the macro crash on MAC, on windows runs much more smoother. I think that what make it crash is the open and close loop, that makes the program goes bad and crash.
Thanks again for the help.