ny version = flytning af celle til andet regneark!

-------  have navnet fra indholdet i mappe1, Celle A15

Vedr. ark4 - iflg. koden behandler du hvert ark i mappe2 - hvor opstår behovet for det 4. ark? I mappe1 behandler du kun ark1 - eller er der noget jeg har misforstået.

I mappe1 skal der indtastes data. Når der så trykkes på knappen, skal den ryge over i mappe2. Hver gang der trykkes send, skal det sættes over i et nyt ark i mappe2. Når man starter en excel-fil findes der jo kun 3 ark. Når man så har indsat data 3 gange, kommer den jo ikke længere. Der skal den gerne selv oprette ark 4, hvis det er muligt.

Og gerne give arket navnet fra indholdet i mappe1, celle A15.

Er det muligt?

Ja - det er muligt - det ville nok være en fordel, hvis du havde mulighed for at sende filerne til: pb@supertekst-it.dk

Koden er anbragt i Ark1 i Mappe1:

Dim sti, mappe2AntalArk, arkNavn, indsatFlag As Boolean
Private Sub CommandButton1_Click()
    sti = ActiveWorkbook.Path          '
    If Right(sti, 1) <> "\" Then        '
        sti = sti + "\"                ' Egen tilføjelse
    End If                              '
   
    Application.ScreenUpdating = False
    x = Sheets("Ark1").Range("A10")
    arkNavn = Sheets("Ark1").Range("A15")
   
    Workbooks.Open Filename:=sti + "mappe2.xls"
    mappe2AntalArk = ActiveWorkbook.Sheets.Count
    indsatFlag = False
   
    For Each sh In Workbooks("mappe2.xls").Sheets
        sh.Activate
        If sh.Range("A10") = "" Then        'hvis A10 er tom så indsæt
            sh.Range("A10") = x:
            sh.Name = arkNavn              'tilpas arkNavn
            indsatFlag = True              'marker for indsat
            Exit For                        'afbryd
        End If
    Next
   
Rem Test om der blev indsat - hvis ikke opret nyt ark
    If indsatFlag = False Then
        opretNytArk arkNavn, x:
    End If
   
    Workbooks("mappe2.xls").Close savechanges:=True
    Application.ScreenUpdating = True
End Sub
Private Sub opretNytArk(arkNavn, værdi)
On Error GoTo fejl
    With ActiveWorkbook
        .Sheets.Add After:=Worksheets(mappe2AntalArk)
        .Sheets(mappe2AntalArk + 1).Name = arkNavn
        .Sheets(mappe2AntalArk + 1).Range("A10").Select
        Selection = værdi:
    End With
    Exit Sub
   
fejl:
    MsgBox ("ArkNavnet " + arkNavn + " er sandsynligvis anvendt i forvejen")
End Sub