flytte et tal over i en anden celle

Hvis du har tallene stående i A1:A12 og du ønsker de store tal i C1 kan følgende makro bruges:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A12")) Is Nothing Then
x = ""
  For y = 1 To 12
  If Cells(y, 1) >= 120 Then
  x = x & " " & Cells(y, 1)
  End If
    Next
    Cells(1, 3) = x
    End If
End Sub

de celler hvor jeg kan skrive i er i : h17:h19 & h32:h34 & v20:v22 & v29:v31 det er de 12 felter hvor større end =120 skal flyttes over i Q7

Mvh Marcussen

Så skulle denne makro kunne klare det:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("h17:h19, h32:h34, v20:v22, v29:v31")) Is Nothing Then
x = ""
  For y = 17 To 21
  If Cells(y, 8) >= 120 Then
  x = x & " " & Cells(y, 8)
  End If
  Next
  For y = 32 To 34
  If Cells(y, 8) >= 120 Then
  x = x & " " & Cells(y, 8)
  End If
  Next
  For y = 20 To 22
  If Cells(y, 22) >= 120 Then
  x = x & " " & Cells(y, 22)
  End If
  Next
  For y = 29 To 31
  If Cells(y, 22) >= 120 Then
  x = x & " " & Cells(y, 22)
  End If
  Next
  Cells(7, 17) = x
  End If
End Sub

super jens48 :)

men det løser ikke helt mit problem så :)
skal lige siges jeg er hel ny i VBA men det ser spændende ud så det vil jeg se mere på i fremtiden...

men mit problem er så

at jeg skal have det første du skrev sammen med 7 andre muligheder...

det vil sige at koden skal hedde:

i Q7  skal jeg have h17:h19 & h32:h34 & v20:v22 & v29:v31
i Q8  skal jeg have h20:h22 & h29:h31 & v23:v25 & v32:v34
i Q9  skal jeg have h23:h25 & h38:h40 & v26:v28 & v35:v37
i Q10 skal jeg have h26:h28 & h35:h37 & v17:v19 & v38:v40
i Q11 skal jeg have i20:i22 & i35:i37 & w20:w22 & w35:w37
i Q12 skal jeg have i17:i19 & i29:i31 & w26:w28 & w38:w40
i Q13 skal jeg have i26:i28 & i38:i40 & w23:w25 & w29:w31
i Q14 skal jeg have i23:i25 & i32:i34 & w17:w19 & w32:w34

MVH Marcussen

ps håber du kan hjælpe mig med mit problem så er jeg nemlig færdig :) på forhånd tak

Da der ikke synes at være nogen systematik i de celler der skal testes, kan jeg ikke se at der er anden mulighed end at gentage makroen 8 gange med lidt ændrede tal.

kan du give mig et hint til at gøre det... har prøvet lidt frem og tilbage men bliver ved med at få fejl. :(

på forhånd tak Marcussen

Du får lige hele koden:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("h17:i40, v17:w40")) Is Nothing Then
'entry of data into Q7
  x = ""
  For y = 17 To 19
  If Cells(y, 8) >= 120 Then
  x = x & " " & Cells(y, 8)
  End If
  Next
  For y = 32 To 34
  If Cells(y, 8) >= 120 Then
  x = x & " " & Cells(y, 8)
  End If
  Next
  For y = 20 To 22
  If Cells(y, 22) >= 120 Then
  x = x & " " & Cells(y, 22)
  End If
  Next
  For y = 29 To 31
  If Cells(y, 22) >= 120 Then
  x = x & " " & Cells(y, 22)
  End If
  Next
  Cells(7, 17) = x

'entry of data into Q8
  x = ""
  For y = 20 To 22
  If Cells(y, 8) >= 120 Then
  x = x & " " & Cells(y, 8)
  End If
  Next
  For y = 29 To 31
  If Cells(y, 8) >= 120 Then
  x = x & " " & Cells(y, 8)
  End If
  Next
  For y = 23 To 25
  If Cells(y, 22) >= 120 Then
  x = x & " " & Cells(y, 22)
  End If
  Next
  For y = 32 To 34
  If Cells(y, 22) >= 120 Then
  x = x & " " & Cells(y, 22)
  End If
  Next
  Cells(8, 17) = x
 
  'entry of data into Q9
  x = ""
  For y = 23 To 25
  If Cells(y, 8) >= 120 Then
  x = x & " " & Cells(y, 8)
  End If
  Next
  For y = 38 To 40
  If Cells(y, 8) >= 120 Then
  x = x & " " & Cells(y, 8)
  End If
  Next
  For y = 26 To 28
  If Cells(y, 22) >= 120 Then
  x = x & " " & Cells(y, 22)
  End If
  Next
  For y = 35 To 37
  If Cells(y, 22) >= 120 Then
  x = x & " " & Cells(y, 22)
  End If
  Next
  Cells(9, 17) = x
 
  'entry of data into Q10
  x = ""
  For y = 26 To 28
  If Cells(y, 8) >= 120 Then
  x = x & " " & Cells(y, 8)
  End If
  Next
  For y = 35 To 37
  If Cells(y, 8) >= 120 Then
  x = x & " " & Cells(y, 8)
  End If
  Next
  For y = 17 To 19
  If Cells(y, 22) >= 120 Then
  x = x & " " & Cells(y, 22)
  End If
  Next
  For y = 38 To 40
  If Cells(y, 22) >= 120 Then
  x = x & " " & Cells(y, 22)
  End If
  Next
  Cells(10, 17) = x
 
  'entry of data into Q11
  x = ""
  For y = 20 To 22
  If Cells(y, 9) >= 120 Then
  x = x & " " & Cells(y, 9)
  End If
  Next
  For y = 35 To 37
  If Cells(y, 9) >= 120 Then
  x = x & " " & Cells(y, 9)
  End If
  Next
  For y = 20 To 22
  If Cells(y, 23) >= 120 Then
  x = x & " " & Cells(y, 23)
  End If
  Next
  For y = 35 To 37
  If Cells(y, 23) >= 120 Then
  x = x & " " & Cells(y, 23)
  End If
  Next
  Cells(11, 17) = x

  'entry of data into Q12
  x = ""
  For y = 17 To 19
  If Cells(y, 9) >= 120 Then
  x = x & " " & Cells(y, 9)
  End If
  Next
  For y = 29 To 31
  If Cells(y, 9) >= 120 Then
  x = x & " " & Cells(y, 9)
  End If
  Next
  For y = 26 To 28
  If Cells(y, 23) >= 120 Then
  x = x & " " & Cells(y, 23)
  End If
  Next
  For y = 38 To 40
  If Cells(y, 23) >= 120 Then
  x = x & " " & Cells(y, 23)
  End If
  Next
  Cells(12, 17) = x
 
  'entry of data into Q13
  x = ""
  For y = 26 To 28
  If Cells(y, 9) >= 120 Then
  x = x & " " & Cells(y, 9)
  End If
  Next
  For y = 38 To 40
  If Cells(y, 9) >= 120 Then
  x = x & " " & Cells(y, 9)
  End If
  Next
  For y = 23 To 25
  If Cells(y, 23) >= 120 Then
  x = x & " " & Cells(y, 23)
  End If
  Next
  For y = 29 To 31
  If Cells(y, 23) >= 120 Then
  x = x & " " & Cells(y, 23)
  End If
  Next
  Cells(13, 17) = x
 
  'entry of data into Q14
  x = ""
  For y = 23 To 25
  If Cells(y, 9) >= 120 Then
  x = x & " " & Cells(y, 9)
  End If
  Next
  For y = 32 To 34
  If Cells(y, 9) >= 120 Then
  x = x & " " & Cells(y, 9)
  End If
  Next
  For y = 17 To 19
  If Cells(y, 23) >= 120 Then
  x = x & " " & Cells(y, 23)
  End If
  Next
  For y = 32 To 34
  If Cells(y, 23) >= 120 Then
  x = x & " " & Cells(y, 23)
  End If
  Next
  Cells(14, 17) = x
 

  End If
End Sub

Mange tak for hjælpen Jens48 :)

MVH Marcussen