Sub SendToExl(FG As MSFlexGrid)
Dim objXLApp    As Excel.Application
Dim objXLWkb    As Excel.Workbook
Dim objXLWks    As Excel.Worksheet
Dim srow        As Integer  'StartZeile
Dim scol        As Integer  'Startspalte
Dim erow        As Integer  'EndZeile
Dim ecol        As Integer  'EndSpalte
Dim r           As Integer  'Zeile
Dim c           As Integer  'Spalte
Dim i           As Integer
 
    On Error Resume Next
    With CommonDialog1
        .CancelError = True
        .Flags = cdlOFNOverwritePrompt
        .InitDir = "C:\Dokumente und Einstellungen\" & g_strNachname & "\Eigene" & _
          "Dateien"
        .Filter = "Textdateien (*.xls)|*.xls"
        .ShowOpen
 
        strDateiName = .FileTitle
        strPfad = .filename
    End With
 
    On Error GoTo err_CreateXLChart
    Set objXLApp = CreateObject("Excel.Application")
    Set objXLWkb = objXLApp.Workbooks.Open(strPfad)
    Set objXLWks = objXLWkb.Worksheets(1)
 
    objXLApp.Visible = False
    objXLApp.Application.ScreenUpdating = False
 
 
    With objXLWks
        sr = 5
        sc = 1
        ec = Me.FG1.Cols - 2
        If Me.cmb_Werk.Text = "Gesamt" Then
 
            .Range(.Cells(sr, sc), .Cells(sr, ec)).UnMerge
            .Columns(2).Select
            Selection.Copy
            Selection.InsertColumnsRight
 
            .Cells(5, 1) = .Cells(5, 1) & "Test"
 
             For c = 1 To 3
                .Cells(5, c + 1) = FG.TextMatrix(1, c)
            Next
 
            For r = FG.FixedRows + 1 To Me.FG1.Rows - 1
                Select Case r
                    Case 4, 6, 8, 11, 18, 27, 28, 31, 37, 48, 50, 63: 'Next r
                    Case Else:
                        For c = FG.FixedCols To Me.FG1.Cols - 2
                            If FG.TextMatrix(r, c) <> "" Then
                                .Cells(srow + r - 1, c + 1) = FG.TextMatrix(r, _
                                  c)
                            End If
                        Next c
                End Select
            Next r
 
 
        End If
    End With
 
    Set objXLApp = Nothing
    Set objXLWkb = Nothing
    Set objXLWks = Nothing
 
End Sub

Wer aufhört sich zu verbessern, hört auf gut zu sein.