Tekst naar kolommen

[gl3nn1987]

Goededag ik heb een vraag. Ik heb een macro opgenomen voor tekst naar kolommen en ik wil dit automatiseren, zodat zodra ik een nieuwe regels erin plak dat hij deze ook netjes overzet naar de kolommen. Helaas zet hij de al overgezette regels nogmaals over waardoor je slechts 1 woord overhoudt, dat terwijl er geen puntkomma meer aanwezig is in die tekst....

.Range("A2:A" & .Range("A65536").End(xlUp).Row).Select
    Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        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)), TrailingMinusNumbers:=True

Iemand een idee hoe ik dit zou kunnen oplossen?

 

[VenA]

Kan je even een voorbeeldje plaatsen? Met daarin een stukje waar het al gescheiden is en een stukje wat er zoal onder geplakt wordt?

 

[gl3nn1987]

Hierbij voorbeeld. Macro zit onder de dubbelklik

bovenste 2 ingevoerde regels is als de macro 2x is afgespeeld
dan 2 na 1x
en dan 2 zonder afgespeeld te zijn.

 

[Cobbe]

Anders kan je ook deze code gebruiken:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim cl As Range
With Sheets("Formulier")
For Each cl In .Range("A2:A" & .Range("A65536").End(xlUp).Row)
  If InStr(1, cl, ";") > 0 Then
   Application.DisplayAlerts = False
     cl.TextToColumns Destination:=cl.Offset(0, 0), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        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)), TrailingMinusNumbers:=True
  End If
Next
End With
End Sub

 

[Cobbe]

Hierbij voorbeeld. Macro zit onder de dubbelklik

bovenste 2 ingevoerde regels is als de macro 2x is afgespeeld
dan 2 na 1x
en dan 2 zonder afgespeeld te zijn.

Als ik me niet vergis worden telkens de vorige gegevens gewist met uw code, tenzij dit de bedoeling is ....

 

[gl3nn1987]

Anders kan je ook deze code gebruiken:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim cl As Range
With Sheets("Formulier")
For Each cl In .Range("A2:A" & .Range("A65536").End(xlUp).Row)
  If InStr(1, cl, ";") > 0 Then
   Application.DisplayAlerts = False
     cl.TextToColumns Destination:=cl.Offset(0, 0), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        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)), TrailingMinusNumbers:=True
  End If
Next
End With
End Sub

Werkt perfect zo hartelijke dank en alvast een fijne kerst!

 

[snb]

of

Sub M_snb()
    With Cells(1).CurrentRegion.Columns(1)
        .AutoFilter 1, "*;*"
        For Each cl In .Offset(1).SpecialCells(12)
          cl.TextToColumns , , , , 0, 1, 0, 0, 0
        Next
        .AutoFilter
    End With
End Sub