Hi, how can I optimize this Macro? I have a lot of these and the sheets they are supposed to read from can be up to 40 columns wide and
at this time 10.000 rows. I would though like the Macro to able to read more, like 20-50k rows. I think it can but it will be quite slow.
Haven't tested it yet.

Also I don't really get if the Macro checks all rows but doesn't print. (I think it does).
If so can I make it not to, to improve performance?

 Sub PersonMapping()
    
    Dim FilePath As String                                                      
    Dim CellData As String                                                      
    Dim Separator As String                                                     
    Dim LastCol As Long
    Dim LastRow As Long
    On Error GoTo ErrMsg
    Application.ScreenUpdating = False
    Separator = Range("I33")                                                    
    
    Sheets("Person Mapping").Select                                            
    ActiveSheet.Range("A1").Select                                              
    
    LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column    
    LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row        
           
    CellData = ""                                                               
    
    FilePath = ThisWorkbook.Path & "\F_PERSON_VO.dat"                           
    
    Open FilePath For Output As #25                                                     
                                                                                       
    For i = 1 To LastRow                                                                
                                                                                       
        For j = 1 To LastCol
        
            If j = LastCol Then
                CellData = CellData + Trim(ActiveCell(i, j).Value)
            Else
                CellData = CellData + Trim(ActiveCell(i, j).Value) + (Separator)        
                
            End If
            
        Next j                                                                          
        
        If Len(Replace(CellData, (Separator), "")) Then Print #25, CellData            
        CellData = ""
        
    Next i

    Close #25
          
       Sheets("DAT file generator").Select     
                                       
WriteDateAuth ' Function

Exit Sub
        
ErrMsg:
    MsgBox "Macro Terminated!" & vbNewLine & "You have erroneous values in Worksheet: " + ActiveSheet.Name

End Sub
Any help would be greatly appreciated.

/BC