Wait time but without freezing (time to dowload data in cells)

[bryan444]

Hi

I'd like to know if you guys have a solution to just make a pause without freezing excel
It is in order to download in cells with the Bloomberg function data before copying them as you can see in this code
With this code, Excel stops working instead of downloading the data

Sub getquotes()
Dim ws As Worksheet
Dim rngTkr As Range
Dim strTkr As String
Dim c As Range
Set ws = Sheet1
Dim strFld As String

'Données pour la seconde etape
Dim rngTkr2 As Range
Dim d As Range

'transposition des stocks + chopper les données de bloomberg
Range("heud").ClearContents
With ws
    Set rngTkr = .Range("A5: A1500").SpecialCells(xlCellTypeConstants) ' ticker range
       i = 1
    For Each c In rngTkr

         strTkr = """" & c.Value & " Equity" & """"
         strFld = """" & "PX LAST" & """"
         .Range("A1").Offset(4, i + 1).Value = "=BDH(" & strTkr & "," & strFld & ",B1, B2)"
         .Range("A1").Offset(3, i + 1).Value = c.Value
         i = i + 2
    Next
End With

Application.Wait (Now + TimeValue("0:00:03"))

'************************** I'D LIKE TO PUT A PAUSE HERE BUT with application.wait it freezes so excel stops working instead of downloading the data

 
Call copydata

End Sub

Sub copydata()

    Dim lngCounter As Long
    Dim lngMax As Long
    Dim lngCol As Long
    Dim wksTwo As Worksheet
    Dim rngTkr As Range
    Dim c As Range
        
     'copier de la sheet1 a la sheet2, on copie en valeurs
    Set wksTwo = Worksheets("Sheet2")
     
    wksTwo.Cells.ClearContents
    Worksheets("Sheet3").Cells.ClearContents
    Worksheets("Sheet4").Cells.ClearContents
    
    Worksheets("Sheet1").Range("zoneselect").Copy
    wksTwo.Range("B1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
     
     ' On enleve les blancs entre la sheet 2 à la sheet3
    wksTwo.Range("A1:BB1").Copy Sheets("Sheet3").Range("B1")
    Sheets("Sheet3").Range("B1").CurrentRegion.SpecialCells(xlCellTypeBlanks).Delete shift:=xlToLeft
    Worksheets("Sheet3").Select
    Range("A1:BB1").Select
    Selection.Cut
    Sheets("Sheet3").Select
    Range("B1").Select
    ActiveSheet.Paste
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Application.CutCopyMode = False
    Selection.Delete shift:=xlToLeft
    
    
'************************ Technique pour prendre la periode personnalisee au début en Workday**************************
Dim datStart As Long
Dim datEnd As Long
Dim lngRow As Long
datStart = Range("datedebut")
datEnd = Range("datefin")

lngRow = 2

For lngCounter = datStart To datEnd
  With Worksheets("Sheet3").Cells(lngRow, "A")
  If (WorksheetFunction.Weekday(CDate(lngCounter), 1) < 7) And (WorksheetFunction.Weekday(CDate(lngCounter), 1) > 1) Then
      .Value = CDate(lngCounter)
      lngRow = lngRow + 1
    End If
  End With
Next lngCounter


     LgDep = 2   ' Ligne de départ du tableau dans la page Sheet2
  ClDep = 2   ' Colonne de départ du tableau dans la page Sheet2

  With Sheets("Sheet2")
    ClFin = .Cells(LgDep, Columns.Count).End(xlToLeft).Column
    LgFin = .Range(.Cells(1, ClDep), .Cells(1, ClFin)).EntireColumn.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  End With
  Nblg = Range("A" & Rows.Count).End(xlUp).Row
  For i = ClDep To ClFin Step 2
    With Range(Cells(2, 2 + (i - ClDep) / 2), Cells(Nblg, 2 + (i - ClDep) / 2))
      .Formula = "=VLOOKUP(RC1,Sheet2!R" & LgDep & "C" & i & ":R" & Nblg & "C" & i + 1 & ",2,TRUE)"
    End With
  Next i

'FIN TEST VLOOOKUP FORMULE EXCEL
  
      Cells.Select
    Selection.Copy
    Sheets("Sheet4").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
        
 Range("A1").Select
  


End Sub

Sub londoncalling()
Call getquotes
End Sub

here is the file (but you wont see the data because you probably won't open the file from a Bloomberg equipied machine ;-)
https://docs.google.com/open?id=0B1X...nRDOW5HRndCWms

Best regards



R