Excel: How to Copy Part of Cells' content into Other Adjacent Cells on Respective Rows

Question

I'm copying HTML-based content and pasting it into a spreadsheet. I need to repeat this process for multiple rows in an accounting document. Because the values or length of the copied strings change and the spaces are uneven, I don't think use of the LEFT, RIGHT or MID functions will work.

Though the source content appears tabular in HTML in six adjacent horizontal cells / columns, Excel views it as unicode and pastes it like this in one cell (note that the column spaces are uneven; all contents displayed are in one cell as text):

Revenues   111,234   222,345    333,456    444,567       555,678
Revenues   666,789   777,890    888,901    999,012       1,111,234

It should instead paste like this (with tabs as separators):

Revenues    111,234 222,345 333,456 444,567 555,678
Revenues    666,789 777,890 888,901 999,012 1,111,234

I've tried every paste special format and none worked. I've also tried recording a macro that cuts the five numeric values from the cell and pastes each separately in adjacent columns as desired.

Below is the recorded macro:

Sub Copy_Cell_Part_and_Paste_In_Adjacent_Cells()
'
' Copy_Cell_Part_and_Paste_In_Adjacent_Cells Macro
'
' Keyboard Shortcut: Ctrl+u
'
    ActiveCell.FormulaR1C1 = "Revenues   "
    Range("B1").Select
    ActiveSheet.Paste
    ActiveCell.FormulaR1C1 = "111,234"
    Range("C1").Select
    ActiveSheet.Paste
    ActiveCell.FormulaR1C1 = "222,345"
    Range("D1").Select
    ActiveSheet.Paste
    ActiveCell.FormulaR1C1 = "333,456"
    Range("E1").Select
    ActiveSheet.Paste
    ActiveCell.FormulaR1C1 = "444,567"
    Range("F1").Select
    ActiveSheet.Paste
End Sub

Yes, the macro has many problems including use of absolute instead of relative references and it copies the original cell content to the fifth cell to the right.

How do I cut (not copy) the numeric values part of a string in a cell and paste the cut values in adjacent cells? If the question need be more specific: (1) How do I automate cutting only part of any selected cell(s) using relative references? (2) How do I distribute the contents of those cut cells to adjacent cells?

EDIT: Changed to clarify the array should be the selected cells, which may in multiple rows in one column

Answer 1

Assuming you have the source text in cell A1, you can try this:

Dim myArr as Variant
myArr = Split(WorksheetFunction.Trim(Range("A1"))
Range("B1").Resize(,Ubound(myArr) - LBound(myArr) + 1).Value = myArr

Or this

Range("A1").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, ConsecutiveDelimiter:=True, Space:=True

Answer 2

You can use regex which is a much more powerful string pattern matching split your string across different cells. Try this code:

Sub PasteInCells()
    Dim regex As Object: Set regex = CreateObject("VBScript.RegExp")
    Dim match As Object
    regex.Global = False
    regex.Pattern = "(\w+)\s+([\d,]+)\s+([\d,]+)\s+([\d,]+)\s+([\d,]+)\s+([\d,]+)"

    Dim strClip As String
    strClip = InputBox("Paste data you want to split", "Paste in Cells")
    Debug.Print strClip
    Set match = regex.Execute(strClip)
    If match.Count <> 0 Then
        For i = 0 To match(0).submatches.Count - 1
            Debug.Print match(0).submatches(i)
            ActiveCell.Offset(0, i).Value = match(0).submatches(i)
        Next
    Else
        MsgBox "Pasted values do not match pattern!", vbCritical
    End If
End Sub

To use this:

1. Copy the string you want split into the clipboard
2. Select the cells your data to be pasted in excel
3. Run the macro
4. Paste values into the input box that appears
5. Data should appear in the selected cells