Overførsel af indtastet værdi til celle i andet regneark.

put denne kode i arkets kodemodul.- ret evt. drev,sti,ark,celle til aktuel
sig til hvis du skal have hjælp til dette.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2")) Is Nothing Then Exit Sub
Dim tal
tal = Range("B2").Value: Range("B2").Value = ""
If tal = "" Then Exit Sub
Workbooks.Open Filename:="C:\Test.xls"
tal = tal + Workbooks("Test").Sheets("Ark1").Range("B2").Value
Workbooks("Test").Sheets("Ark1").Range("B2").Value = tal
ActiveWorkbook.Close savechanges:=True
ActiveCell.Offset(-1, 0).Activate
End Sub

I eksemblet anvendes celle B2 som indtastningsfelt, værdien overføres
til projektmappe Test.xls i celle B2

de 2 følgende kode er måske mere anvendelig, hvis der er mange på hinanden følgende indtastninger.- B2 er indtastningsfelt, B1 er opsamlingsfelt, Dobbeltklik på B1 for at overføre værdien. (begge indsættes i arkets kodemodul)

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2")) Is Nothing Then Exit Sub
    Range("b1").Value = Range("b1").Value + Range("b2").Value
    Range("B2").Select: ActiveCell.Value = ""
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Me.Range("B1")) Is Nothing Then
      Dim t1
      t1 = Range("B1").Value: Range("B1").Value = ""
        Workbooks.Open Filename:="C:\Test.xls"
      t1 = t1 + Workbooks("Test").Sheets("Ark1").Range("B2").Value
      Workbooks("Test").Sheets("Ark1").Range("B2").Value = t1
    ActiveWorkbook.Close savechanges:=True
    End If
End Sub

Hej..Tak for hjælp.

Jeg har ret mange celler som skal være indtastningsfelter. Skal koden (den af 21/02-2006 12.07:47) indsættes for hver celle og tilrettes manuelt med cellenavnene?

Kan du forklare lidt mere præcist hvor og hvordan koden skal indsættes. (er nybegynder - så hav tålmodighed).

hvilke celler er indtastningsfelter ?

Jeg kan tilsende dig de regneark jeg har påbegyndt...hvis du vil...så kan du danne dig et billede af projektet...er det ok?
Hvis ja, hvilken mailadresse skal jeg sende til?

ja ok det er nok det nemmeste :-) - husk lige at skrive hvilke celler der skal anvendes

pm@madsen.tdcadsl.dk

Ok...jeg sender filer til dig...men det bliver halvsent idet jeg ikke har filerne her og nu...God dag...

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim adr As String
    If Not IsNumeric(Target) Then Exit Sub
    On Error GoTo XIT
    Application.EnableEvents = False
    adr = Target.Address
    Sheets("Gr.1").Range(adr).Value = Sheets("Gr.1").Range(adr).Value + Range(adr).Value
    Range(adr).Value = ""

XIT:
    Application.EnableEvents = True
End Sub

Hvor langt er du nået ?

*

*

Hej!

Beklager har først set din kommentar nu. OK. Tak regnearket er færdigt og allerede i brug. Tak for hjælp.

så skal du bare lige markere box med mit navn, og klik accepter