Gennemløbe 50+ ark med VBA kode
HejJeg har gennem noget tid forsøgt mig med en VBA kode, der skal gennemløbe 50+ ark, hvor jeg skal have VBA til at kopiere handelsdata for derefter at indsætte dem i et oversigtsark. Selve koden kører fint, men stopper efter ca 40 kopi/sæt ind hændelser. Det er som om, at koden kun kan gennemløbe x-antal ark, og så skal den genstartes fra hvor den stoppede for at køre igennem. Og det kan den så, men jeg vil gerne have den til at køre hele vejen igennem, da andre også skal kunne benytte den. Jeg håber, at nogen kan dreje problemet.
Kode:
Sub test()
Dim navn As String
Dim hovedstol As Double
Dim valuta As Variant
Dim handelskurs As Double
Dim terminskurs As Double
Dim indikator As Integer
Dim ws As Worksheet
Application.ScreenUpdating = False
x = 0
o = 2
For Each Worksheet In Worksheets
o = o + 1
'information starter i række 27 og forsætter x antal rækker nede
Do Until Cells(27 + x, 2) = 1 Or Cells(27 + x, 2) = -1
If Cells(27 + x, 2) = "" Then
ActiveSheet.Next.Select
x = 0
End If
Loop
navn = Cells(7, 2).Value
hovedstol = Cells(27 + x, 3).Value
valuta = Cells(27 + x, 4).Value
handelskurs = Cells(27 + x, 8).Value
terminskurs = Cells(27 + x, 9).Value
indikator = Cells(27 + x, 2).Value
Sheets("data").Activate
Cells(o, 1).Value = "Termin"
Cells(o, 2).Value = navn
Cells(o, 3).Value = valuta
Cells(o, 4).Value = hovedstol
Cells(o, 4).Activate
Selection.NumberFormat = "#,##0.00"
Cells(o, 5).Value = handelskurs
Cells(o, 5).Activate
Selection.NumberFormat = "#,##0.00"
Cells(o, 6).Value = terminskurs
Cells(o, 6).Activate
Selection.NumberFormat = "#,##0.00"
Cells(o, 7).Value = (terminskurs - handelskurs) * hovedstol * indikator
Cells(o, 7).Activate
Selection.NumberFormat = "#,##0.00"
Sheets(navn).Activate
x = x + 1
Next Worksheet
End Sub
