Makro som sammen kører data fra 3 filer. = 200 point

Kan lade sig gøre via VBA...

Skal forsøge senere....

Hej, har du fået set på en løsning?

Endnu ikke - men det sker snart

Send en mail - så returnerer jeg en model, hvori alle 3 filer optræder.

(Mailadresse under min profil)

Rem Version 1 - VBA koden anbringes under arket "kunder"
Rem ====================================================
Dim filTabel As Variant, antalRækker As Long, filSti As String

Const ID = "fil 1.xls"

Dim xFil As Object
Private Sub Worksheet_Change(ByVal Target As Range)
Dim kundenavn As String
On Error GoTo gåVidere
   
    filTabel = Array("fil 1.xls", "fil 2.xls", "fil 3.xls")

    If Target.Column = 1 And Target.Text <> "" And LCase(ActiveWorkbook.Name) = ID Then
        antalRækker = findAntalRækker()
        kundenavn = Target.Value
       
        If findesKunde(kundenavn, antalRækker) > 0 And Target.Row < antalRækker - 1 Then
            Rows(Target.Row).Select
            Selection.Delete
        Else
            sorter antalRækker
            ActiveSheet.Columns.AutoFit
                 
            opdater2Andre antalRækker
            MsgBox ("Opdatering af kunder udført")
        End If
    End If
    Exit Sub
   
gåVidere:
'    Stop
End Sub
Private Function findSti()
    findSti = ActiveWorkbook.Path
    If Right(findSti, 1) <> "\" Then
        findSti = findSti + "\"
    End If
End Function
Private Function findAntalRækker()
    With ActiveSheet
        findAntalRækker = ActiveCell.SpecialCells(xlLastCell).Row
    End With
End Function
Private Function findesKunde(kundenavn, sidsterække)
    With ActiveSheet.Range("A1:A" & CStr(sidsterække))
        Set c = .Find(kundenavn, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            findesKunde = c.Row
        Else
            findesKunde = 0
        End If
    End With
End Function
Private Sub sorter(sidsterække)
    ActiveSheet.Range("A1:A" & CStr(sidsterække)).Select

    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End Sub
Private Sub opdater2Andre(sidsterække)
Dim f As Byte
    filSti = findSti
   
    ActiveSheet.Range("A:A").Select
    Selection.Copy
   
    For f = 0 To UBound(filTabel)
        If ActiveWorkbook.Name <> filTabel(f) Then
            Set xFil = CreateObject("Excel.Application")
            With xFil
                .Workbooks.Open filSti + filTabel(f)
                opdaterKunder sidsterække
            End With
        End If
    Next f
   
    Application.CutCopyMode = False
    Range("A1").Select
End Sub
Private Sub opdaterKunder(sidsterække)
    With xFil
        .Sheets("kunder").Activate
        .Range("A1").Select
       
        .ActiveSheet.Paste
        .Columns.AutoFit
        .Range("A1").Select
       
        .ActiveWorkbook.Save
        .Application.Quit
    End With
   
    Set xFil = Nothing
End Sub

Tak for hjælpen, det ser ud til at virke..
Nu skal jeg bare ha flyttet det over i mine filer.

Send lige en besked så får du nogle "gryn"

Godt Nytår!!

Selv tak - også godt nytår til dig.