Need to separate email addresses, where they have no separation!

[larrylime]

Example is below. Which was pasted from a word doc copy. If I post the copied text in gmail, it does the separation! But if I try to post the list in excel, it puts all the content into one cell. Maybe there is some prepasting setup I can do in excel before pasting that would do the separation??? Or, HOW CAN I GET THESE SEPARATED!



robperez1@bellsouth.netorigamifleet@gmail.comnaquanchance@yahoo.comjeanpierrefica@gmail.commairatraders@gmail.comrp12520@gmail.com

 

[Logit]

.
see if this works :

Option Explicit


Sub replaceStringInCell()


    'Source: https://powerspreadsheets.com/
    'For further information: https://powerspreadsheets.com/excel-vba-replace-substitute/


    'declare object variable to hold reference to cell you work with
    Dim myCell As Range


    'declare variables to hold parameters for string replacement (string to replace, replacement string, and number of replacements)
    Dim myStringToReplace As String
    Dim myReplacementString As String
    Dim myNumberOfReplacements As Long


    'identify cell you work with
    Set myCell = ActiveSheet.Range("A1")

    myStringToReplace = ".com"
    myReplacementString = ".com/"
    myNumberOfReplacements = 30000
    'replace string in cell you work with, and assign resulting string to Range.Value property of cell you work with
    myCell.Value = Replace(Expression:=myCell.Value, Find:=myStringToReplace, Replace:=myReplacementString, Count:=myNumberOfReplacements)


    myStringToReplace = ".net"
    myReplacementString = ".net/"
    'replace string in cell you work with, and assign resulting string to Range.Value property of cell you work with
    myCell.Value = Replace(Expression:=myCell.Value, Find:=myStringToReplace, Replace:=myReplacementString, Count:=myNumberOfReplacements)
    myNumberOfReplacements = 30000

    myStringToReplace = ".edu"
    myReplacementString = ".edu/"
    'replace string in cell you work with, and assign resulting string to Range.Value property of cell you work with
    myCell.Value = Replace(Expression:=myCell.Value, Find:=myStringToReplace, Replace:=myReplacementString, Count:=myNumberOfReplacements)
    myNumberOfReplacements = 30000


Macro1
End Sub


Sub Macro1()
'
' Macro1 Macro
'


'
    Range("A1").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
        TrailingMinusNumbers:=True
ConvertRangeToColumn
End Sub




Sub ConvertRangeToColumn()
'Updateby20131126
Dim Range1 As Range, Range2 As Range, Rng As Range
Dim rowIndex As Integer
'xTitleId = "KutoolsforExcel"
Set Range1 = ActiveSheet.Range("A1:XFD1")
Set Range2 = ActiveSheet.Range("A3")
rowIndex = 0
Application.ScreenUpdating = False
For Each Rng In Range1.Rows
    Rng.Copy
    Range2.Offset(rowIndex, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
    rowIndex = rowIndex + Rng.Columns.Count
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[larrylime]

That solved all the problems! THANK YOU FOR HELPING!!!!!!!!!!!!

.
see if this works :

Option Explicit


Sub replaceStringInCell()


    'Source: https://powerspreadsheets.com/
    'For further information: https://powerspreadsheets.com/excel-vba-replace-substitute/


    'declare object variable to hold reference to cell you work with
    Dim myCell As Range


    'declare variables to hold parameters for string replacement (string to replace, replacement string, and number of replacements)
    Dim myStringToReplace As String
    Dim myReplacementString As String
    Dim myNumberOfReplacements As Long


    'identify cell you work with
    Set myCell = ActiveSheet.Range("A1")

    myStringToReplace = ".com"
    myReplacementString = ".com/"
    myNumberOfReplacements = 30000
    'replace string in cell you work with, and assign resulting string to Range.Value property of cell you work with
    myCell.Value = Replace(Expression:=myCell.Value, Find:=myStringToReplace, Replace:=myReplacementString, Count:=myNumberOfReplacements)


    myStringToReplace = ".net"
    myReplacementString = ".net/"
    'replace string in cell you work with, and assign resulting string to Range.Value property of cell you work with
    myCell.Value = Replace(Expression:=myCell.Value, Find:=myStringToReplace, Replace:=myReplacementString, Count:=myNumberOfReplacements)
    myNumberOfReplacements = 30000

    myStringToReplace = ".edu"
    myReplacementString = ".edu/"
    'replace string in cell you work with, and assign resulting string to Range.Value property of cell you work with
    myCell.Value = Replace(Expression:=myCell.Value, Find:=myStringToReplace, Replace:=myReplacementString, Count:=myNumberOfReplacements)
    myNumberOfReplacements = 30000


Macro1
End Sub


Sub Macro1()
'
' Macro1 Macro
'


'
    Range("A1").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
        TrailingMinusNumbers:=True
ConvertRangeToColumn
End Sub




Sub ConvertRangeToColumn()
'Updateby20131126
Dim Range1 As Range, Range2 As Range, Rng As Range
Dim rowIndex As Integer
'xTitleId = "KutoolsforExcel"
Set Range1 = ActiveSheet.Range("A1:XFD1")
Set Range2 = ActiveSheet.Range("A3")
rowIndex = 0
Application.ScreenUpdating = False
For Each Rng In Range1.Rows
    Rng.Copy
    Range2.Offset(rowIndex, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
    rowIndex = rowIndex + Rng.Columns.Count
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[Logit]

.
Great !

You are welcome.