Excel 2003 SP3 - Makro - fehlerhafte Zusammenführung der Daten von zwei seperaten CSV-Tabellen

Hallo Zusammen,

Ich arbeite mit einem Informationssystem von Trackwise. Wenn ich bestimmte Infos im Tabellenformat aus diesem System exportiere, dann bekomme ich diese Daten in zwei seperaten CSV-Tabellen. Die Daten beider Tabellen lassen sich anhand einer "PR ID"-Nummer zusammenführen. Diese ist in jeder Zeile zu finden und wenn beide Tabellen eine übereinstimmende Nummer haben werden beide Daten in einer neuen Tabelle in einer Zeile nebeneinander dargestellt. Bei "PR ID"-Nummern die 4-stellig oder kleiner sind funktioniert das Makro einwandfrei, aber sobald es 5-stellig wird werden die Daten sinnfrei untereinanderweg in der neuen Tabelle zusammengeführt. Ich habe im hier unten zusehenden Code versucht eine Einschränkung wie "kleiner gleich 4" oder etwas ähnliches zu finden, war aber ohne Erfolg.

Kann mir jemand sagen wieso es mit den 5-stelligen "PR ID"-Nummer nicht richtig funktioniert? Vielen Dank!!!!!!! Gruß TecAttack

Sub MergeSheets()

    ' opens two workbooks and merges data from the second to be opened into the first one  

    Application.ScreenUpdating = False

    Dim Sourcefile As String 'opens sourcefile (where date are merged in)  
    With Application.FileDialog(msoFileDialogOpen)
        .Title = "file to be merged in"  
        .Filters.Add "csv-file", "*.csv"  
        .Show
        Sourcefile = .SelectedItems(1)
    End With
    On Error Resume Next
    
    Dim Gridfile As String 'opens gridfile (where date come from)  
    With Application.FileDialog(msoFileDialogOpen)
        .Title = "file containing the grid fields"  
        .Filters.Add "csv-file", "*.csv"  
        .Show
        Gridfile = .SelectedItems(1)
    End With
    On Error Resume Next
        
    'getting the filename of the gridfile-dir-string to close it later  
    Dim x As Variant
    x = Split(Gridfile, "\")  
    Gridfile = x(UBound(x))
        
    'file with data to be copied out of being opened  
    Workbooks.Open Filename:=Gridfile
    Workbooks(Gridfile).Worksheets(1).Activate
    'range to be copied will be determined  
    Range("A1", Cells(ActiveSheet.UsedRange.Rows.count, ActiveSheet.UsedRange.Columns.count)).Select  
    Selection.Copy
    
    'file the date to be copied into being opened  
    Workbooks.Open Filename:=Sourcefile
    Workbooks(Sourcefile).Activate
    'data where merged into the sourcefile  
    Dim NewPrColumn As Integer
    NewPrColumn = ActiveSheet.UsedRange.Columns.count + 1
    Cells(1, NewPrColumn).Select
    ActiveSheet.Paste
    
    'now the big one: sort-algorithm  
    
    Dim i As Integer
    Dim j As Integer
    Dim sPrID As Integer
    Dim gPrID As Integer
     
    For i = 2 To ActiveSheet.UsedRange.Rows.count
        sPrID = Cells(i, 1).Value
        gPrID = Cells(i, NewPrColumn).Value
        If gPrID > sPrID Then
            If Not sPrID = 0 Then
                Range(Cells(i, NewPrColumn), Cells(i, ActiveSheet.UsedRange.Columns.count)).Insert
            End If
        End If
        If gPrID < sPrID Then
            If Not gPrID = 0 Then
                Range(Cells(i, 1), Cells(i, NewPrColumn - 1)).Insert
            End If
        End If
    Next i
    
    ' draw lines  
    For i = 2 To ActiveSheet.UsedRange.Rows.count
        If Not Cells(i, 1).Value = Cells(i + 1, 1).Value Then
            Rows(i).Borders(xlEdgeBottom).LineStyle = xlContinuous
        End If
    Next i
    
    
    'gridfile-workbook is being closed - all relevant data are in the sourcefile-workbook now  
    Workbooks(Gridfile).Close savechanges:=False
    Application.ScreenUpdating = False
    
    ' Überschrift Fett machen, sonstige Grafische Einstellungen  
    Rows(1).Font.Bold = True
    Rows(1).VerticalAlignment = xlTop
    Rows(1).Borders(xlEdgeBottom).LineStyle = xlContinuous
    Columns(NewPrColumn).Borders(xlEdgeLeft).LineStyle = xlContinuous
    Columns(NewPrColumn).Borders(xlEdgeLeft).Weight = xlThick
    Dim dummy As String
    dummy = Cells(1, 1).Value
    Cells(1, 1).Value = dummy & vbLf
    Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.count, ActiveSheet.UsedRange.Columns.count)).Select
    With Selection
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlThick
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlThick
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlThick
    End With
    
    ' Kopf und Fußzeilen festlegen  
    With ActiveSheet.PageSetup
        .CenterFooter = "page &P of &N"  
        .CenterHeader = "" & Überschrift  
        .RightHeader = "&D"  
        .PrintTitleRows = "$1:$1"  
        .Orientation = xlLandscape
        .CenterHorizontally = True
        .Zoom = False
        .LeftMargin = Application.InchesToPoints(0.196850393700787)
        .RightMargin = Application.InchesToPoints(0.196850393700787)
        .FitToPagesWide = 1
        .FitToPagesTall = 10000
    End With
    
End Sub