Import af data fra et andet regneark

Velkommen til..

Filerne "Mandskab???.xls" ligger de i samme folder (mappe)?
Hvis forskellen er månedsforkortelsen "jan / feb / mar/ apr" o.s.v. - så er det vel et spørgsmål om at vælge "måned".

Hej Supertekst

Ja mandskab??.xls ligger i den samme folder på dette år altså /.../2009/mandskab-apr.xls osv. så man skulle nok kunne vælge år og mdr.

Ok - er i gang med at opbygge en model.

I princippet kan hele arket "Mandskab" kopieres over til filen lønseddel - idet det bestående ark "Udkald-timer" slettes og det kopierede omdøbes - eller ?

nej helst ikke, da jeg har nogle formler m.m. som ligger i kolonnerne K-O, ville helst at den kun slettede/tomte kolonnerne A-J og så kopiered dem over fra mandskab. hvis det kan lade sig gøre ellers må jeg ligge formlerne på et andet ark.

Ok..
- det er intet problem..

Vender tilbage senere...

Hej igen.

Har en model klar - send en mail (adresse under min profil) så returnerer jeg hele modellen.

(Vil også blive vist her...)

Alletiders. du har modtaget en mail, og som der også står der så må du da gerne post den her inde også så andre også kan drage nytte af dine talenter. :-)

På forhånd mange tak.

Kode i Userform:

Private Sub CommandButton1_Click()                  'Ok
    If Me.ListBox1.ListIndex <> -1 And Me.ListBox2.ListIndex <> -1 Then
        kopierMandskabsData Ark2.xsti + Me.ListBox1 + "\" + Me.ListBox2
    Else
        MsgBox ("Fil ikke udpeget!")
    End If
End Sub
Private Sub CommandButton2_Click()                  'Luk
    Unload UserForm1
End Sub
Private Sub ListBox1_Click()                        'årsMappe valgt
    Me.ListBox2.Clear
    visMandskabsMåneder Me.ListBox1
End Sub
Private Sub UserForm_activate()
    Me.ListBox1.Clear
    Me.ListBox2.Clear
   
    visÅrsMapper
End Sub
Private Sub visÅrsMapper()
    Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(Ark2.xsti)
    Set fc = f.SubFolders
   
    For Each f1 In fc
        Me.ListBox1.AddItem f1.Name
    Next
End Sub
Private Sub visMandskabsMåneder(årsMappeNavn)
    Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(Ark2.xsti + årsMappeNavn)
    Set fc = f.Files
    For Each f1 In fc
        Me.ListBox2.AddItem f1.Name
    Next
End Sub
Rem ============= OVERFØRSEL ===============
Private Sub kopierMandskabsData(filNavn)
Dim udkaldArk, antalRækker
Dim mdXLS, mdArk, ræk
On Error GoTo lukStatus
    Application.ScreenUpdating = False

Rem slet gl. data i rækkerne A - J
    antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
    Range("A1:J" & CStr(antalRækker)).Select
    Selection.ClearContents
   
    Cells(1, 1).Select
   
    Set udkaldArk = ActiveWorkbook.Sheets("udkald-timer")
   
Rem hent data fra mandskabs-fil
    Set mdXLS = CreateObject("Excel.application")
    With mdXLS
        .Workbooks.Open filNavn
        Set mdArk = .ActiveWorkbook.Sheets("mandskab")
        mdArk.Activate
       
Rem fortsæt indtil data i A = tom
        For ræk = 1 To 65000
            If mdArk.Cells(ræk, 1) <> "" Then
                For kol = 1 To 10
                    indhold = mdArk.Cells(ræk, kol)
                    udkaldArk.Cells(ræk, kol) = indhold
                Next kol
            Else
                Exit For
            End If
        Next ræk
    End With
   
lukStatus:
    On Error Resume Next
   
    mdXLS.Application.Quit
    Set mdXLS = Nothing
   
    Application.ScreenUpdating = True
   
    MsgBox ("Mandskabs-data overført")
End Sub