Probably an easy fix but I’m a rookie, I am extracting data from a csv attachment in Outlook and when it pastes into my xlsm workbook it retains the csv formatting. I need it to spread across the cells/columns like it does automatically upon opening the csv file. I add this data incrementally and you’ll see the difference in formatting quite easily. Thanks

Sub ExtractActivitiesData()
    
    ' Late binding. Outlook variables declared as Object.
    Dim OutlookApp As Object
    Dim ExcelApp As Object
    Dim ThisWorkbook As Object
    Dim OutlookNamespace As Object
    Dim OutlookFolder As Object
    Dim OutlookItem As Object
    Dim Attachment As Object
    
    Dim ExcelWorkbook As Workbook
    Dim ExcelWorksheet As Worksheet
    
    Dim TempFilePath As String
    
    Dim RangeToExtract As Range
    Dim RangeToCopy As Range
    
    ' Set the path where you want to save the extracted data
    TempFilePath = Environ$("temp")

    'ThisWorkbook must be initialized explicitly
    Set ExcelApp = CreateObject("Excel.Application")
    Set ThisWorkbook = ExcelApp.Workbooks.Open("T:3-Lending Systems AnalystCollections Master Workbook.xlsm")
    
    ' Set the range where you want to paste the extracted data
    
    ' **** ThisWorkbook is used - code must be in Excel ****
    Set RangeToExtract = ThisWorkbook.Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1) ' Change to your desired range
    
    ' Create a new Outlook application
    Set OutlookApp = Application 'Application points to Outlook.Application in Outlook VBA
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
    
    ' Specify the Outlook folder where the email is located
    Set OutlookFolder = OutlookNamespace.GetDefaultFolder(6).Folders("Projects").Folders("Collections").Folders("Activities Reports") ' Change to the appropriate folder
    
    ExcelApp.ScreenUpdating = False
    
    ' Loop through the emails in the folder
    For Each OutlookItem In OutlookFolder.Items
    
        'Debug.Print OutlookItem.Subject
        
        If TypeName(OutlookItem) = "MailItem" Then
        
            ' Check if the email has the desired attachments
            
            If OutlookItem.Attachments.Count >= 0 Then
                
                ' Check if the attachments have specific titles
                'Dim AttachmentTitles(1) As String
                'AttachmentTitles(1) = "*.csv"
                ' Replace with the title of the first attachment
                
                
                Dim AttachmentCount As Long
                AttachmentCount = 0
                
                ' Loop through the attachments in the email
                
                
                For Each Attachment In OutlookItem.Attachments
                    
                    
                        
                        'If Attachment.FileName = AttachmentTitles(1) Then
                            
                            ' Save the attachment to the temporary location
                            Attachment.SaveAsFile TempFilePath & "1"
                            
                            ' Open the saved Excel attachment
                            Set ExcelWorkbook = Workbooks.Open(TempFilePath & "1")
                            
                            ' Copy the data from the Excel attachment
                            Set RangeToCopy = ExcelWorkbook.Sheets(1).Range("A2:R5000") ' Assuming data is in the first sheet
                            
                            RangeToCopy.Copy Destination:=RangeToExtract.Offset ' Offset to paste data in different columns
                            
                            
                            ' Close the Excel attachment
                            ExcelWorkbook.Close SaveChanges:=False
                            
                            ' Clean up Excel objects
                            Set ExcelWorksheet = Nothing
                            Set ExcelWorkbook = Nothing
                            
                            ' Increment the attachment count
                            AttachmentCount = AttachmentCount + 1
                            
                            ' Exit the loop if all three attachments are processed
                            If AttachmentCount >= 1 Then Exit For
                            
                       
                        
                    
                    
                Next Attachment
                
            End If
        
        End If
        
    Next OutlookItem

    
    ' Clean up Outlook objects
    Set OutlookItem = Nothing
    Set OutlookFolder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp = Nothing
    
    ' Delete the temporary Excel files
    
        If Dir(TempFilePath & "1") <> "" Then
            Kill TempFilePath & "1"
        End If
        
    
    ExcelApp.ScreenUpdating = False
    
    ThisWorkbook.Save
    
    ThisWorkbook.Close
    
    ExcelApp.Quit

    


    
End Sub

!

Reference Image:
pasting formatting issue