Hvis= C11=ht kør marco

Selve koden kan se slik ut...men hva skal trigge macroen?

Public Sub test()
Dim vdB() As Variant
  If Cells(11, 3).Value = "HT" Then
    vdB() = Cells(11, 3).Resize(1, 4).Value
    Sheets("HT").Select
    Cells(1, 1).Resize(1, 4) = vdB
    Rows(1).Insert
  End If
End Sub

Jeg har vedlagt en xls fil.

Sub HT()
'
' HT Makro
'

'
    Range("C11:F11").Select
    Selection.Copy
    Sheets("HT").Select
    Range("A1").Select
    ActiveSheet.Paste
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown
    Sheets("Vognløb").Select
    Range("C5").Select
End Sub

men det gør den macro..

på arket er det hvis Ht kommer i vogn og man mærker F5 køre den en marco
Når den er kørt skal HT marcoen køre hvis HT står i C11

Kan man ikke lave noget så de køre sammen med HT Marco

____________________
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim vTmp() As Variant
  If Target.Address = "$F$5" Then
  Call Add_vognløb
  End If
End Sub
_______________________

  Sub Add_vognløb()
  '
  ' Add_vognløb Makro
  '
 
  '
      Range("C5:E5").Select
      Selection.Copy
      Range("C10").Select
      ActiveSheet.Paste
      Range("C10").Select
      Application.CutCopyMode = False
      Selection.Copy
      Range("F10").Select
      ActiveSheet.Paste
      Application.CutCopyMode = False
      ActiveCell.FormulaR1C1 = "=NOW()"
      Range("F10").Select
      Selection.Copy
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
      Range("C10:F10").Select
      Range("F10").Activate
      Selection.Font.Bold = False
      With Selection.Font
          .Name = "Arial"
          .Size = 10
          .Strikethrough = False
          .Superscript = False
          .Subscript = False
          .OutlineFont = False
          .Shadow = False
          .Underline = xlUnderlineStyleNone
          .ColorIndex = xlAutomatic
      End With
      Selection.Copy
      Sheets("Printliste").Select
      Range("A1").Select
      ActiveSheet.Paste
      Rows("1:1").Select
      Application.CutCopyMode = False
      Selection.Insert Shift:=xlDown
      Range("A1").Select
      Sheets("Vognløb").Select
      Rows("10:10").Select
      Selection.Insert Shift:=xlDown
      Range("C5:E5").Select
      Range("E5").Activate
      Selection.ClearContents
      Range("C5").Select
      ActiveWorkbook.Save
  End Sub
______________

er ikke sikker på hva du mener,.. hva med denne

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim vTmp() As Variant
  If Target.Address = "$F$5" Then
  Call Add_vognløb
  If Cells(11,3).Value = "HT" Then Call HT
  End If
End Sub

Eller  denne

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim vTmp() As Variant
  If Target.Address = "$F$5" Then
    If Cells(11,3).Value = "HT" Then Call HT 
    Call Add_vognløb 
  End If
End Sub

Det er sagen. men den skal så også virke med ht før jeg arbejder med folk som ikke kan høre.. :S eller en formel som laver stort bogstav foran..

hvis man kan få den til at tage ht Ht hT med ville det være lækkert

Cells(11, 3) = UCase(Cells(11, 3))

If UCase(Cells(11,3).Value) = "HT" Then Call HT

Nej virker ikke helt... :S

Den gør det først når man adder en ny så hvis det står HT i 11,3 kommer den først over hvis man adder en ny...

Hva med denne, da vil alt som kommer inn i regnearket få store bokstave

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Value = UCase(Target.Value )) 
Dim vTmp() As Variant
  If Target.Address = "$F$5" Then
  Call Add_vognløb
  End If
End Sub

Hvis dette kun gjelder ht Ht eller hT, er dette en mulighet.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim vTmp() As Variant
If UCase(Target.Value )) = "HT" Then Target.Value = "HT"
  If Target.Address = "$F$5" Then
  Call Add_vognløb
  End If
End Sub

prøver igjen:-)
Etter som jeg ikke vet hvilke variant du skal benytte,
kommer det 3 eksempler:

1)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim vTmp() As Variant
  If UCase(Target.Value )) = "HT" Then Target.Value = "HT" 
  If Target.Address = "$F$5" Then
  Call Add_vognløb
  If Cells(11,3).Value = "HT" Then Call HT
  End If
End Sub

2)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim vTmp() As Variant
  If UCase(Target.Value )) = "HT" Then Target.Value = "HT"
  If Cells(11,3).Value = "HT" Then Call HT
    If Target.Address = "$F$5" Then
    Call Add_vognløb 
  End If
End Sub

3)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim vTmp() As Variant
  If UCase(Target.Value )) = "HT" Then Target.Value = "HT"
    If Target.Address = "$F$5" Then
    Call Add_vognløb 
  End If
  If Cells(11,3).Value = "HT" Then Call HT
End Sub

De 3 eksempler laver "Compile error: Syntax error

unnskyld, det er en ) for mye i
If UCase(Target.Value )) = "HT" Then Target.Value = "HT"

skal være slik
If UCase(Target.Value ) = "HT" Then Target.Value = "HT"

virker men laver rum-time error mismatch '13' på alle 3

får ikke tid til å se på dette før i kveld

Da har jeg tatt en titt på ditt flotte regneark!
Kan du ikke bekrive hvordan "Vognsiden fungerer"
Og hvordan du legger den ut på internett.

Jeg har teste ditt regneark med denne koden, den fungerer hos meg.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Address = Cells(5, 6).Address Then
    Target.Offset(, -3).Value = Trim(Target.Offset(, -3).Text)
    If UCase(Target.Offset(, -3).Value) = "HT" Then
      Target.Offset(, -3).Value = "HT"
    End If
    For Each c In Range(Cells(5, 3), Cells(5, 5))
      If IsEmpty(c) Then
        Cells(5, 3).Select
        Exit Sub
      End If
    Next
    Cells(5, 6).FormulaR1C1 = "=now()"
    Call Add_vognløb
    If Cells(11, 3).Value = "HT" Then Call HT
  End If
End Sub

jeg fant ingen HT i ditt regneark, benyttet derfor denne:

Public vdB() As Variant

Public Sub HT()
  With Worksheets("Vognløb")
    vdB = Range(.Cells(11, 3), .Cells(11, 6))
  End With
  With Worksheets("HT")
    .Rows(2).Insert
    Range(.Cells(2, 1), .Cells(2, 4)) = vdB
  End With
  ActiveWorkbook.Save
End Sub

jeg prøvde meg på vognløpet også, men den fungerer ikke helt,
hvis ønskelig kan jeg se på det senere.

Sub Add_vognløb()
  With Worksheets("Vognløb")
    vdB = Range(.Cells(5, 3), .Cells(5, 6))
    Range(.Cells(5, 3), .Cells(5, 6)).ClearContents
    .Cells(5, 3).Select
    .Rows(10).Insert
    Range(.Cells(10, 3), .Cells(10, 6)) = vdB
  End With
  With Worksheets("Printliste")
    .Rows(2).Insert
    Range(.Cells(2, 1), .Cells(2, 4)) = vdB
  End With
  ActiveWorkbook.Save
End Sub

Sub Add_vognløb()
  With Worksheets("Vognløb")
    With Range(.Cells(5, 3), .Cells(5, 6))
      vdB = .Value
      .ClearContents
      .Resize(1, 1).Select
    End With
    .Rows(11).Insert
    With Range(.Cells(11, 3), .Cells(11, 6))
      .Value = vdB
      .Borders().LineStyle = xlContinuous
      .Interior.ColorIndex = xlNone
    End With
  End With
  With Worksheets("Printliste")
    .Rows(2).Insert
    Range(.Cells(2, 1), .Cells(2, 4)) = vdB
  End With
  ActiveWorkbook.Save
End Sub

på vognløb skal man kunne adde nye som den gør med denne
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim vTmp() As Variant
  If Target.Address = "$F$5" Then
    Call Add_vognløb
  End If
End Sub
Ud over det skal den køre en ekstre macro hvis der står HT
det gør den også men først efter man har addet en anden som ikke er HT.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim vTmp() As Variant
  If Target.Address = "$F$5" Then
    If Cells(11, 3).Value = "HT" Then Call HT
    Call Add_vognløb
  End If
End Sub

problemet er at hvis det er en HT man adder venter den med at simde den over på ark HT til man adder en ny... om det er HT eller en anden...

sender over all kode på nytt:
først "vognmodulen"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Address = Cells(5, 6).Address Then
    Target.Offset(, -3).Value = Trim(Target.Offset(, -3).Text)
    If UCase(Target.Offset(, -3).Value) = "HT" Then
      Target.Offset(, -3).Value = "HT"
    End If
    For Each c In Range(Cells(5, 3), Cells(5, 5))
      If IsEmpty(c) Then
        Cells(5, 3).Select
        Exit Sub
      End If
    Next
    Cells(5, 6).FormulaR1C1 = "=now()"
    Call Add_vognløb
    If vdB(1, 1) = "HT" Then Call HT
  End If
End Sub

Public vdB() As Variant
Sub Add_vognløb()
  With Worksheets("Vognløb")
    With Range(.Cells(5, 3), .Cells(5, 6))
      vdB = .Value
      .ClearContents
      .Resize(1, 1).Select
    End With
    .Rows(11).Insert
    With Range(.Cells(11, 3), .Cells(11, 6))
      .Value = vdB
      .Borders().LineStyle = xlContinuous
      .Interior.ColorIndex = xlNone
    End With
  End With
  With Worksheets("Printliste")
    .Rows(2).Insert
    Range(.Cells(2, 1), .Cells(2, 4)) = vdB
  End With
  ActiveWorkbook.Save
End Sub


Public Sub HT()
  With Worksheets("HT")
    .Rows(2).Insert
    Range(.Cells(2, 1), .Cells(2, 4)) = vdB
  End With
  ActiveWorkbook.Save
End Sub

Jah det ser ud til at virke... kan man gøre det så det ikke er et most at skrive noger i bemærkning!?

det skal alt være et most at skrive noger i bemærkning
denne setningen:
  For Each c In Range(Cells(5, 3), Cells(5, 5))
      If IsEmpty(c) Then
        Cells(5, 3).Select
        Exit Sub
      End If
    Next
Gjør at du ikke kommer videre før alle felter er fylt ut.
Gjør et forsøk :-)

unnskyld, du ønsker at det IKKE SKAL VÆRE ET MOST, RETTELSE KOMMER :-)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Address = Cells(5, 6).Address Then
    Target.Offset(, -3).Value = Trim(Target.Offset(, -3).Text)
    If UCase(Target.Offset(, -3).Value) = "HT" Then
      Target.Offset(, -3).Value = "HT"
    End If
    For Each c In Range(Cells(5, 3), Cells(5, 4))
      If IsEmpty(c) Then
        Cells(5, 3).Select
        Exit Sub
      End If
    Next
    Cells(5, 6).FormulaR1C1 = "=now()"
    Call Add_vognløb
    If vdB(1, 1) = "HT" Then Call HT
  End If
End Sub

Jeps så er den perfekt...

flott :-)

nej... :S den laver ikke rammer om de 4 celler når den smider dem uver.. :S

uver= Over....

vi gir oss ikke :-)
nå blir det rammer både på print og HT
Hvis du ønsker å ta bort rammene på den ene, skal du ta bort:
.Borders().LineStyle = xlContinuous


Public vdB() As Variant
Sub Add_vognløb()
  With Worksheets("Vognløb")
    With Range(.Cells(5, 3), .Cells(5, 6))
      vdB = .Value
      .ClearContents
      .Resize(1, 1).Select
    End With
    .Rows(11).Insert
    With Range(.Cells(11, 3), .Cells(11, 6))
      .Value = vdB
      .Borders().LineStyle = xlContinuous
      .Interior.ColorIndex = xlNone
    End With
  End With
  With Worksheets("Printliste")
    .Rows(2).Insert
   
    With Range(.Cells(2, 1), .Cells(2, 4))
      .Value = vdB
      .Borders().LineStyle = xlContinuous
    End With
     
  End With
  ActiveWorkbook.Save
End Sub


Public Sub HT()
  With Worksheets("HT")
    .Rows(2).Insert
    With Range(.Cells(2, 1), .Cells(2, 4))
      .Value = vdB
      .Borders().LineStyle = xlContinuous
    End With
  End With
  ActiveWorkbook.Save
End Sub

Mange tak. Så er det som det skal være.... :D