Automatisk overførsel af værdier ved tryk på knap

Hej Peter

Kan du evt. blive lidt mere specifik ?

- Er det altid fra de samme 5 celler på sheet1 ?
- Det uge nummer du snakker om ... findes det både på sheet1 + 2 ?
- Hvad bestemmer, hvorpå sheet2, celler skal kopieres til ?

- ???


Med venlig hilsen, Nicolai

Hej Nicolai

Undskyld det sene svar, der kom lige lidt ferie imellem.

Ja det er altid de samme 5 celler på sheet1 der skal overføres/kopieres.
Der hvor værdierne skal kopieres hen ændres fra uge til uge, fx idag overføres de til række5, næste uge række 6, osv osv.. dette ville være ok hvis der ved overføringsknappen var et felt hvor man skulle definere hvor de skulle overføreres til eller ugenummer.

Uge nummeret jeg snakker om findes kun på sheet2, sheet 1 er et arbejdssheet hvor en logfil importeres og der laves en optælling... det er så resultatet af denne optælling jeg gerne vil overfører til sheet 2.

Håber det gav dig en bedre ide om problemstillingen.

Mvh Peter

Hej Peter

Kan du evt. oplyse, hvilke 5 celler på sheet1 det altid drejer sig om ?

Og på sheet2 ... skal værdierne kopieres nedad fortløbende og med start i hvilken kolonne ?

Du kan evt. poste et eksempel af sheet2 ?

Med venlig hilsen, Nicolai

Hej Nicolai

Det var et eksempel med de 5 celler :o) det der skal bruges er overførsel/kopi af følgende

Data der skal overføres er på sheet4

Området C3 til M6 i sheet4 skal overføres til:
- Ved 1. overføres data til sheet1 C176 til M179.
- Ved 2. overførss data til sheet1 C180 til M173.
- osv....

Området C7 til M10 i sheet4 skal overføres til:
- Ved 1. overføres data til sheet2 C176 til M179.
- Ved 2. overførss data til sheet2 C180 til M173.
- osv....

Håber det hjalp lidt på forståelsen :o)

Mvh Peter

Hej Peter

Har lige kigget i mine gemmer ... og fundet et noget i retningen af det du efterspørger ... Måske du kan bruge det - med eller uden tilretning ?

Jeg har mailet Excel filen til dig.
Kig på den og lad høre ?

Med venlig hilsen, Nicolai

Hej Peter

Der er et nyt Excel ark på vej gennem gmailen :o)

Med venlig hilsen, Nicolai

Hej,

Smart mange tak.

Hvordan får jeg adgang til koden så jeg kan rette den til?

Laver du et svar så du kan få dine points :o)

Mange tak for hjælpen.

Mvh Peter

Kunne man ved overfører data knappen indikere at man nu er nået til uge nummer x, dvs denne ville også blive forøget ved hvert tryk!!
X ville også værer smart at overfører til de enkelte atk om muligt...... samt 1234 udfor de enkelte rækker...

Sender dig en retur mail med data/eksempel....

Hej Peter

Tak for mail.

Det ugenummer du vil overføre ... er det et individuelt valgt ugenummer eller er det, det aktuelle ugenummer udfra systemets (pc´ens) tid ?

Og hvor ved knappen kunne du tænke dig ugenummeret skrevet ?

Med venlig hilsen, Nicolai

Hej igen

Ugenummeret ville være det næste i rækken og det ville altid stå som jeg har illustreret på det eksempel jeg har sendt.. dvs 4 celler er merged også er ugenummeret kommet ind...

Mvh Peter

Hej Peter

Jeg kigger lige på det ...

Dog et sidste spørgsmål:
Hvis arket er tom, dvs. første gang der trykkes på knappen, hvorfra skal koden så vide hvilket ugeummer der skal startes med ?

Med venlig hilsen, Nicolai

Hej,

I dette tilfælde ville jeg mene at nummer 1 er det korrekte at starte udfra.
Men måske et felt (Week" kunne anvendes så hvis en uge skulle springes over kunne dette nummer manuelt ændres?!

Mvh Peter

Hej Peter

You´ve got mail :o)

Med venlig hilsen, Nicolai

Hej,

Mange tak og tak for hjælpen.

Husk at lave et svar så du kan få dine point :)

Mvh Peter

Hej Peter

Okay så ... hermed et svar
Du gi´r bare lyd, hvis skidtet ikke fungerer ?


Jeg skriver lige koden i her på Eksperten senere i dag.


Med venlig hilsen, Nicolai

Hej Alle

Hermed koden, som kopierer 2 områder fra sheet4 til hver sit område på henholdsvis sheet1 og sheet2.

Koden ligger bag en knap på sheet4


Private Sub cmdOverførData_Click()
Dim r As Integer
Dim o As Range


Application.ScreenUpdating = False


'** Kopier første område på Sheet4 **

    'kopier cellerne "C3:M6" på Ark4
    Sheets("Sheet4").Range("C3:M6").Copy

    'gør Ark1 til det aktive ark
    Sheets("Sheet1").Activate
   
    'vælg celle "C" i række 176
    ActiveSheet.Range("C176").Select
   
   
    'hvis den aktive celle er tom - Første log.
    If ActiveCell.Value = "" Then
       
        'indsæt det kopierede, startende fra den aktive celle
        ActiveCell.PasteSpecial xlPasteValues
       
       
        '* Indsæt 1,2,3,4 *

        'vælg cellen til venstre for den aktive celle
        ActiveCell.Offset(0, -1).Select
       
       
                'sæt værdierne 1,2,3,4
                For i = 0 To 3
                       
                    ActiveCell.Offset(i, 0).Value = i + 1
                   
                Next i
               
               
               
        '* Merge og indsæt ugenummer *
                       
        'vælg cellen til venstre for den aktive celle
        ActiveCell.Offset(0, -1).Select
       
        'vælg og merge området fra og med den aktive celle til og med 3 rækker ned
        ActiveSheet.Range(ActiveCell, ActiveCell.Offset(3, 0)).Select
        Selection.Merge
       
        'hvis celle o11 på sheet4 er tom ... sæt uge nummer = 1
        If Sheet4.Range("o11").Value = "" Then
       
            Selection.Value = 1
           
            'sæt celle o11 på sheet4 = 1
            Sheet4.Range("o11").Value = 1
           
       
        'ellers sæt uge nummer = værdien i celle o11 på sheet4
        Else
       
            Selection.Value = Sheet4.Range("o11").Value
                         
        End If
       
       
             
        '***********
       

        'fjern kopimarkeringen fra Ark4
        Application.CutCopyMode = False

        'gør Ark4 til det aktive ark
        Sheets("Sheet4").Activate

        'vælg celle "A1" på det aktive ark
        Range("A1").Select


    Else
   
        'tildel variablen r, rækkenummeret på sidste række indeholdende data
        r = ActiveSheet.Range("C65536").End(xlUp).Row

   
        'vælg celle "C" i rækken efter sidste række indeholdende data
        ActiveSheet.Range("C" & r + 1).Select

        'indsæt det kopierede, startende fra den aktive celle
        ActiveCell.PasteSpecial xlPasteValues


        '* Indsæt ugenummer samt 1,2,3,4 *

        'vælg celle "B" i rækken med sidste række indeholdende data
        ActiveSheet.Range("B" & r).Select
       
        'kopier cellerne i området med ugenummer + 1,2,3,4
        ActiveSheet.Range("B" & r, "A" & r - 3).Copy

        'vælg celle "A" i rækken med sidste række indeholdende data
        ActiveSheet.Range("A" & r + 1).Select
        ActiveCell.PasteSpecial


        'sæt uge nummer = værdien i celle o11 på sheet4
        Selection.Value = Sheet4.Range("o11").Value
       
                       
       
       
        '***********
     
     
        'fjern kopimarkeringen fra Ark4
        Application.CutCopyMode = False

        'gør Ark4 til det aktive ark
        Sheets("Sheet4").Activate

        'vælg celle "A1" på det aktive ark
        Range("A1").Select
       
    End If
   



'** Kopier andet område på Sheet4 **

   
    'kopier cellerne "C7:M10" på Ark4
    Sheets("Sheet4").Range("C7:M10").Copy

    'gør Ark2 til det aktive ark
    Sheets("Sheet2").Activate
   
    'vælg celle "C" i række 176
    ActiveSheet.Range("C176").Select
   
   
    'hvis den aktive celle er tom - Første log.
    If ActiveCell.Value = "" Then
       
        'indsæt det kopierede, startende fra den aktive celle
        ActiveCell.PasteSpecial xlPasteValues

       
        '* Indsæt 1,2,3,4 *

        'vælg cellen til venstre for den aktive celle
        ActiveCell.Offset(0, -1).Select
       
       
            'sæt værdierne 1,2,3,4
            For i = 0 To 3
                   
                ActiveCell.Offset(i, 0).Value = i + 1
               
            Next i
               
               
               
        '* Merge og indsæt ugenummer *
                       
        'vælg cellen til venstre for den aktive celle
        ActiveCell.Offset(0, -1).Select
       
        'vælg og merge området fra og med den aktive celle til og med 3 rækker ned
        ActiveSheet.Range(ActiveCell, ActiveCell.Offset(3, 0)).Select
        Selection.Merge
       
       
        'hvis celle o11 på sheet4 er tom ... sæt uge nummer = 1
        If Sheet4.Range("o11").Value = "" Then
       
            Selection.Value = 1
           
            'sæt celle o11 på sheet4 = 1
            Sheet4.Range("o11").Value = 1
           
       
        'ellers sæt uge nummer = værdien i celle o11 på sheet4
        Else
       
            Selection.Value = Sheet4.Range("o11").Value
       
                 
        End If
       
         
             
        '***********



        'fjern kopimarkeringen fra Ark4
        Application.CutCopyMode = False

        'gør Ark4 til det aktive ark
        Sheets("Sheet4").Activate

        'vælg celle "A1" på det aktive ark
        Range("A1").Select


    Else
   
        'tildel variablen r, rækkenummeret på sidste række indeholdende data
        r = ActiveSheet.Range("C65536").End(xlUp).Row

   
        'vælg celle "C" i rækken efter sidste række indeholdende data
        ActiveSheet.Range("C" & r + 1).Select

        'indsæt det kopierede, startende fra den aktive celle
        ActiveCell.PasteSpecial xlPasteValues



        '* Indsæt ugenummer samt 1,2,3,4 *

        'vælg celle "B" i rækken med sidste række indeholdende data
        ActiveSheet.Range("B" & r).Select
       
        'kopier cellerne i området med ugenummer + 1,2,3,4
        ActiveSheet.Range("B" & r, "A" & r - 3).Copy

        'vælg celle "A" i rækken med sidste række indeholdende data
        ActiveSheet.Range("A" & r + 1).Select
        ActiveCell.PasteSpecial


        'sæt uge nummer = værdien i celle o11 på sheet4
        Selection.Value = Sheet4.Range("o11").Value
       
             
       
        '***********



        'fjern kopimarkeringen fra Ark4
        Application.CutCopyMode = False

        'gør Ark4 til det aktive ark
        Sheets("Sheet4").Activate

        'vælg celle "A1" på det aktive ark
        Range("A1").Select
       
    End If
   
   
    'sæt celle o15 på sheet4 = den aktuelle uge
    Sheet4.Range("o15").Value = Sheet4.Range("o11").Value
   
   
   
    'fremskriv celle o11 på sheet4 med 1
    Sheet4.Range("o11").Value = Sheet4.Range("o11").Value + 1
   
Application.ScreenUpdating = True
End Sub


Med venlig hilsen, Nicolai