Paste, Data, Text to Column Works Manually, But Not as Macro

[alex20850]

I work with a number of distribution lists and emails with lists of people in the To: field.
I need to track who is getting what.
I copied the names from Outlook,
pasted them into a cell in Excel,
used Data, Text to Columns
Highlighted the cells,
Pasted Special using Transpose.

Doing it manually it works fine.
It crashes with "Run-time error '1004': Paste method of worksheet class failed."
What's wrong?

Thanks,
Alex

Sub Outlook2Excel()
'
' Outlook2Excel Macro
' Addresses to Rows
' Use of Macro: After names have been copied from an Outlook To: field, this macro is
' to:
' 1. Paste the names into an Excel cell
' 2. Using the Data, Text to Columns menu choice using semicolons to break
' the names into separate columns.
' 3. Highlight all the cells with names.
' 4. Copy the names.
' 5. Move to the next cell down and Paste Special using Transpose.
'
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1)), _
        TrailingMinusNumbers:=True
        Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End Sub

 

[SkipVought]

Hi,

See if this will work for you. I would be better if you post VBA code questions in forum707 in the future...

Sub Outlook2Excel()
'
' Outlook2Excel Macro
' Addresses to Rows
' Use of Macro: After names have been copied from an Outlook To: field, this macro is
' to:
' 1. Paste the names into an Excel cell
' 2. Using the Data, Text to Columns menu choice using semicolons to break
' the names into separate columns.
' 3. Highlight all the cells with names.
' 4. Copy the names.
' 5. Move to the next cell down and Paste Special using Transpose.
'
    With ActiveSheet
        .Paste
        Application.CutCopyMode = False
        .Columns(1).TextToColumns _
            Destination:=.Range("A1"), _
            DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Tab:=True, _
            Semicolon:=True, _
            Comma:=False, _
            Space:=False, _
            Other:=False, _
            FieldInfo _
            :=Array( _
                Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
                Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1) _
                    ), _
            TrailingMinusNumbers:=True
            
        .[A1].CurrentRegion.Copy
        .Range("A3").PasteSpecial _
            Paste:=xlPasteAll, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=True
    End With
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}