fletning af filer

Er det muligt at få en kopi af filerne - eller uddrag?
Kan evt. sendes til: pb@supertekst-it.dk

det kan desværre ikke lade sig gøre, siden det er konfidentielle informationer i dem..

jeg har skrevet dette indtil videre:

Sub MergeFiles()
    Dim strTemp(312) As String
    Dim intI, intJ, intK As Integer
    intJ = 0
    intK = 2
    For intI = 4 To 315
        strTemp(intJ) = Worksheets(1).Range("B" & intI)
        Worksheets(2).Range("A" & intK) = strTemp(intJ)
        intJ = intJ + 1
        intK = intK + 1
    Next intI
End Sub

alle værdierne består af tal, men tallene skal skrives ind som strenge, fordi de er for lange (får bare skrevet dem ind som 2,74E+14 osv..

jeg kan som sagt ikke sende dig filerne, men jeg kan give mere uddybet information, hvis du fortæller mig hvad du ikke forstår / mangler at få at vide.. :-)

Fil 1: Ark 1: Værdi A og B
Fil 2: Ark 1: Værdi A og C

Kan du ikke kopier værdierne fra fil 2 over på et ark 2 i fil 1, og så lave et lopslag?

Ok - jeg forsøger uden filer...

stop endelig det du laver, jeg har fundet ud af det.. jeg formaterede bare cellerne, og istedet for flere filer fik jeg bare overført dem til ark istedet for, så det blev nemt nok..

Ok - men nu kan du se hvad det blev til (har først set din kommentar efter færdiggørelsen).

Rem Koden anbringes i Fil1/Ark1
Rem Fil1 & 2 forventes at ligge i samme mappe
Rem =========================================
Dim fil2XLS, sti, ark2Ræk
Const fil2Navn = "fil2.xls"            '<------------- kan tilpasses
Sub fletningAfFiler()
    Application.ScreenUpdating = False
    sti = hentSti
    åbnFil2
    traverserFil1
    lukFil2
    Application.ScreenUpdating = True
   
    MsgBox ("Fletning er udført")
End Sub
Private Function hentSti()
    hentSti = ActiveWorkbook.Path
    If Right(hentSti, 1) <> "\" Then
        hentSti = hentSti + "\"
    End If
End Function
Private Sub åbnFil2()
    Set fil2XLS = CreateObject("Excel.Application")
    With fil2XLS
        .Workbooks.Open sti + fil2Navn
    End With
End Sub
Private Sub lukFil2()
    fil2XLS.Application.Quit
    Set fil2XLS = Nothing
End Sub
Private Sub traverserFil1()
Dim aVærdi, bVærdi, cVærdi
    ark2Ræk = 1
   
    For ræk = 1 To 65000
        ActiveWorkbook.Sheets(1).Activate
        aVærdi = Cells(ræk, 1)
        bVærdi = Cells(ræk, 2)
        If aVærdi = "" Then
            Exit Sub
        Else
            cVærdi = findesVærdi(aVærdi)
            If cVærdi <> "" Then
                opbygArk2 aVærdi, bVærdi, cVærdi
            End If
        End If
    Next ræk
End Sub
Private Function findesVærdi(aVærdi)                'Findes aVærdi i fil2
    With fil2XLS
        .Sheets(1).Activate
        For ræk = 1 To 65000
            If .Cells(ræk, 1) <> "" Then
                If aVærdi = .Cells(ræk, 1) Then
                    findesVærdi = .Cells(ræk, 3)        'returner C-værdi
                    Exit Function
                End If
            Else
                findesVærdi = ""
                Exit Function
            End If
        Next ræk
    End With
    findesVærdi = ""
End Function
Private Sub opbygArk2(aVærdi, bVærdi, cVærdi)
    ActiveWorkbook.Sheets(2).Activate
    With ActiveSheet
        .Cells(ark2Ræk, 1).Select
        Selection.NumberFormat = "@"
        .Cells(ark2Ræk, 2).Select
        Selection.NumberFormat = "@"
        .Cells(ark2Ræk, 3).Select
        Selection.NumberFormat = "@"

        .Cells(ark2Ræk, 1) = CStr(aVærdi)
        .Cells(ark2Ræk, 2) = CStr(bVærdi)
        .Cells(ark2Ræk, 3) = CStr(cVærdi)
       
        .Columns.AutoFit
    End With
   
    ark2Ræk = ark2Ræk + 1
End Sub

ja, undskyld for det sene svar fra mig af, men det blev hurtigt ændret til at alt skal kun udføres i en enkelt fil.. lukker