Makro - Automatisk opdatering i andre ark

Hvordan ser din posteringsfil ud ? Er der datofelter som identificerer de enkelte poster, og står afd. også i et felt for sig ?

posteringsfilen har altid samme format og ser nogenlunde sådan her ud.

A: LØNNUMMER
B: NAVN
C: AFDELING
D: LART
E: ELM 4
F: ELM 5
G: Beløb

Jeg har altså ikke noget datofelt, idet posteringslisten dannes hver måned, på baggrund af månedens transaktioner ( vi køre Lessor 3 )
Men afdelingen står altid i en kolonne for sig selv.
Og det er så hele rækken som skal opdateres i de pågældende ark

Venlig hilsen
IDa

Kære Ida,

Som jeg forstår opgaven handler det i bund og grund om at i laver det samme hver måned og det vil du gerne have en marco til at løse !?

Såfremt der er en struktur/logik i tingene - hvilket jeg formoder der er .. ivl det selvfølgelig være muligt at skrive noget VBA (macro) til løsning af denne opgave.

Jeg vil gerne hjælpe dig - men det kræver indsigt i filerne og hvad der skal ske ved en kørsel. Skulle det være interessant er du velkommen til at kontakte mig (claus@shola.dk) så skal jeg gerne se på opgaven ...

Er problemet løst?

Ikke endnu jeg har spurgt min chef om lov til at sende en kopi af filerne til claus, men han har endnu ikke taget stilling til det.
Så alle løsninger er velkommen

Hilsen
Ida

Jeg tror ikke det er et større problem - men der melder sig følgende spørgsmål:
- hvilke afdelinger skal opdateres - altså hvad indikere dette?
- hvordan er de enkelte afd.filer navngivet - ved afdnr - eller ?
- er de faneblade navngivet med måned (3 tegn) - eller ligger de i rækkefølge
  JAN = fane1 o.s.v.
- Hvor mange poster er der i posteringsarket?
- Ligger alle filer i sammemappe?

Proceduren må vel så være, at posteringsfilen åbnes og de enkelte rækker opdateres i de respektive afd.månedsfane i næste ledige række.

For mit vedkommende er det ikke nødvendigt med kopi af filerne!

Hvis du sender en mail til: pb@supertekst-it.dk
- så skal jeg en model, som fungerer på basis af det indtilnu oplyste.

Herefter kan der arbejdes videre med denne.

Forstår godt at man ikke er villig til atr sende således data ud til "tilfælde" mennesker .. i givet fald kunne du sende en fil med fiktive data. Således jeg/vi kan se hvad den indeholder samt en beskrivelse af hvad "programmet"/marcroen skal kunne ...

Hej Ida
Noget nyt??

Følgende kode er fremsendt:

Rem PosteringsArk
Rem =============
Dim xSti, postRækker, pMåned, pAfdeling
Const pStartrække = 2                              'Overskrifter forventes i PostArk

Rem Afdeling
Rem ========
Dim xlsAfdeling As Object, afdRækker
Sub workbook_activate()                            'Når PosteringsArk aktiveres
Dim sv
    sv = MsgBox("Skal opdatering udføres?", vbYesNo)
    If sv = 6 Then
        findSti
        postRækker = findAntalRækker
        pMåned = ActiveWorkbook.Sheets(1).Name
        behandlingAfPosteringer
       
        MsgBox ("Opdatering er afsluttet")
    End If
End Sub
Private Sub findSti()                              'Stien til filerne hentes
    xSti = ActiveWorkbook.Path
    If Right(xSti, 1) <> "\" Then
        xSti = xSti + "\"
    End If
End Sub
Private Function findAntalRækker()                  'Antal rækker i PosteringsArk beregnes
        findAntalRækker = ActiveCell.SpecialCells(xlLastCell).Row
End Function
Private Sub behandlingAfPosteringer()              'Rækkerne i PosteringsArk behandles
Dim række
    For række = pStartrække To postRækker
        pAfdeling = Cells(række, 3)                'Afdeling hentes fra rækken
        opdaterAfdeling række
    Next række
End Sub
Private Sub opdaterAfdeling(række)                  'Afd.filen hentes
    Set xlsAfdeling = CreateObject("Excel.application")    'overskrifter forventes ikke
   
    With xlsAfdeling
        .Workbooks.Open xSti + CStr(pAfdeling) + ".xls"
        .Visible = False
        .Sheets(pMåned).Activate                    'aktiver fane med post.ark's måned
       
        If .Cells(1, 1) = "" Then                  'hvis afd.måneds-Ark er tom
            afdRækker = 0
        Else
            afdRækker = .ActiveCell.SpecialCells(xlLastCell).Row
        End If
        afdRækker = afdRækker + 1
       
        .Cells(afdRækker, 1) = Cells(række, 1)      'Den aktuelle række post.ark opdateres
        .Cells(afdRækker, 2) = Cells(række, 2)
        .Cells(afdRækker, 3) = Cells(række, 3)
        .Cells(afdRækker, 4) = Cells(række, 4)
        .Cells(afdRækker, 5) = Cells(række, 5)
        .Cells(afdRækker, 6) = Cells(række, 6)
        .Cells(afdRækker, 7) = Cells(række, 7)
        .ActiveWorkbook.Save                        'Afd.filen gemmes
    End With
       
    xlsAfdeling.Quit                                '- lukkes
    Set xlsAfdeling = Nothing                      '- objektet nedlægges
End Sub