Macro Copy/Paste then split column

[CalvT]

I need a macro that would copy some data from say A1 on Sheet 1, then paste it on A1 on Sheet 2, then perform a text to column, delimited by space.
Is this possible? Thanks a lot

 

[Rick Rothstein]

I need a macro that would copy some data from say A1 on Sheet 1, then paste it on A1 on Sheet 2, then perform a text to column, delimited by space.
Is this possible? Thanks a lot

You do not have to do copy it to the cell and then use Text-To-Columns on it, you can do it directly...

Sub CopyAndSplit()
  Dim Words() As String
  Words = Split(Sheets("Sheet1").Range("A1").Value)
  Sheets("Sheet2").Range("A1").Resize(, UBound(Words) + 1).Value = Words
End Sub

 

[Vikas Verma]

Hi I hope it will help you....

Sub test()


Dim rng As Range
Dim sh As Worksheet
Dim Rcount As Integer


First.Range("A1").CurrentRegion.Copy Destination:=second.Range("A1")
Set sh = Worksheets(2)
With sh
Set rng = .Range("A1" & ":" & "a19")
Set rng = .Range(rng, .Cells(.Rows.Count, rng.Column).End(xlUp))
rng.TextToColumns Destination:=rng, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
End With
End Sub

Warm Regards,

Vikas Verma
India.

 

[CalvT]

Sub CopyAndSplit()
  Dim Words() As String
  Words = Split(Sheets("Sheet1").Range("A1").Value)
  Sheets("Sheet2").Range("A1").Resize(, UBound(Words) + 1).Value = Words
End Sub

Rick, this is great, only as it is a set of numbers, not words, the numbers are stored as words, and the fomulas now do not work. Is there a way to change it?

Thanks

 

[Rick Rothstein]

Rick, this is great, only as it is a set of numbers, not words, the numbers are stored as words, and the fomulas now do not work. Is there a way to change it?

You did not mention these were numbers in your original message and since you were using Text-To-Columns, I assumed they were text. Try this modification to my code and see if it works for you...

Sub CopyAndSplit()
  Dim Words As Variant
  Words = Split(Sheets("Sheet1").Range("A1").Value)
  With Sheets("Sheet2").Range("A1").Resize(, UBound(Words) + 1)
    .Value = Words
    .Value = .Value
  End With
End Sub

 

[CalvT]

Sub CopyAndSplit()
  Dim Words As Variant
  Words = Split(Sheets("Sheet1").Range("A1").Value)
  With Sheets("Sheet2").Range("A1").Resize(, UBound(Words) + 1)
    .Value = Words
    .Value = .Value
  End With
End Sub

That works perfectly, thanks for your time.
Cheers

 

[CalvT]

Rick, is it possible to edit this formula so that it copies-and-splits every value in the A column? And puts them on their respective Sheet 2 row?
Sorry to bother you, thanks for your time!

 

[Rick Rothstein]

Rick, is it possible to edit this formula so that it copies-and-splits every value in the A column? And puts them on their respective Sheet 2 row?
Sorry to bother you, thanks for your time!

I think this does what you want...

Sub CopyAndSplit()
  Dim Words As Variant, Cell As Range
  For Each Cell In Sheets("Sheet1").Range("A1", Cells(Rows.Count, "A").End(xlUp))
    Words = Split(Cell.Value)
    With Sheets("Sheet2").Range(Cell.Address).Resize(, UBound(Words) + 1)
      .Value = Words
      .Value = .Value
    End With
  Next
End Sub

 

[CalvT]

Sub CopyAndSplit()
  Dim Words As Variant, Cell As Range
  For Each Cell In Sheets("Sheet1").Range("A1", Cells(Rows.Count, "A").End(xlUp))
    Words = Split(Cell.Value)
    With Sheets("Sheet2").Range(Cell.Address).Resize(, UBound(Words) + 1)
      .Value = Words
      .Value = .Value
    End With
  Next
End Sub

Just the job! Thanks a lot