Meerdere regels tekst onder elkaar in 1 cel met VBA

[joskjos]

Hallo,

Ik heb een bestand met Tabblad1 waarin gegevens staan zoals:
KolomA Cel1: tekst regel1
KolomB Cel1: tekst regel2
KolomC Cel1: tekst regel3
KolomD Cel1: tekst regel4
KolomE Cel1: tekst regel5
KolomF Cel1: tekst regel6

Nu wil ik dat de macro het volgende doet: Kopieren van kolomA cel1, KolomB cel1, KolomC cel1, KolomD cel1, KolomE cel1, KolomF cel1.
En dit vervolgens plakken in Tabblad 2 KolomA Cel1.

Deze 6 losse cellen moeten dus 1 cel worden en dan cel2 onder cel1 enz. Dus ik krijg dan 1cel met 6tekst regels.

Heeft iemand hier een oplossing voor?

Gr,
Jos

 

[gast0660]

Hoi,
met deze mischien?
Selecteer een aantal cellen in blad 1 en copieer naar blad 2
Gebruik daarna de knop (macro)

 

[joskjos]

Ja dit is wat ik ongeveer bedoel.
Kan je er ook een Enter in zetten?
Zie het bestand zoals ik de uitkomst wil hebben.

Bekijk bijlage allesineencel.xlsm

Gr,
Jos

 

[gast0660]

Hoi,
Enter zal niet lukken (toch niet met mijn kennis)
Heb deze aangepast naar CTRL m (gewoon m gekozen voor macro
Hoe ik de tekst onder elkaar moet krijgen heb ik voorlopig geen kant en klare oplossing.

 

[edmoor]

@gast0660:
Wijzig dit : sArgs = sArgs + c.Text + " "
Eens in dit: sArgs = sArgs + c.Text + vbCrLf

 

[gast0660]

Hoi,
@ Edmoor thanks, weer iets bijgeleerd :thumb:
@joskjos
In bijlage
aangepaste versie volgens de tip van Edmoor

 

[joskjos]

Perfect!
Kan je ook maken dat alleen de bovenste tekst vet gedrukt is en de rest niet?

Gr,
Jos

 

[VenA]

Of om het geheel wat sneller te maken.

Sub VenA()
ar = Sheets(1).Cells(1).CurrentRegion
    For j = 1 To UBound(ar)
        For jj = 1 To UBound(ar, 2)
                c00 = c00 & ar(j, jj) & Chr(10)
        Next jj
        c01 = c01 & "|" & c00
        c00 = ""
    Next j
Sheets(2).Cells(1).Resize(UBound(Split(Mid(c01, 2), "|")) + 1) = Application.Transpose(Split(Mid(c01, 2), "|"))
End Sub

 

[snb]

Gebaseerd op het bestand van VenA:

Sub M_snb()
   Blad3.Cells(1) = Join(Application.Transpose(Blad1.Cells(1).CurrentRegion.Columns(1)), vbLf)
End Sub

@Edmoor

Gebruik voor concatenatieoperaties altijd de ampersand &

 

[joskjos]

Perfect!
Kan je ook maken dat alleen de bovenste tekst vet gedrukt is en de rest niet?

Gr,
Jos

 

[edmoor]

@Edmoor

Gebruik voor concatenatieoperaties altijd de ampersand &

Doe ik altijd. Het was slechts de regel van gast0660 zelf met een tip van mij.

 

[snb]

Pak van mijn hart

 

[snb]

Had je zelf gekund met de macrorecorder.

Sub M_snb()
   Blad3.Cells(1) = Join(Application.Transpose(Blad1.Cells(1).CurrentRegion.Columns(1)), vbLf)
   Blad3.Cells(1).Characters(1, InStr(Blad3.Cells(1), vbLf) - 1).Font.Bold = True
End Sub

 

[joskjos]

De code werkt niet goed. Ik krijg dan alleen in Cel1 alles vetgedrukt.
Ik wil dus in Cel1 alleen tekst1 vet gedrukt en de rest niet. Cel2 ook alleen tekst1 vet gedrukt en de rest niet enz.

Gr,
Jos

 

[gast0660]

Hoi,
Maak hier een macro van

Sub BoldCell()
Dim lngLineFeedPosn
With Range("A1")
 lngLineFeedPosn = Instr(1,.Value,Chr(10))
  If lngLineFeedPosn > 0 
    .Characters(1,Instr(1,.Value,Chr(10))).Font.Bold = True
  End If
End With
With Range("A2")
lngLineFeedPosn = Instr(1,.Value,Chr(10))
  If lngLineFeedPosn > 0 Then  
    .Characters(1,Instr(1,.Value,Chr(10))).Font.Bold = True
  End If
End With
With Range("A3")
lngLineFeedPosn = Instr(1,.Value,Chr(10))
  If lngLineFeedPosn > 0 Then  
    .Characters(1,Instr(1,.Value,Chr(10))).Font.Bold = True
  End If
End With
With Range("A4")
lngLineFeedPosn = Instr(1,.Value,Chr(10))
  If lngLineFeedPosn > 0 Then  
    .Characters(1,Instr(1,.Value,Chr(10))).Font.Bold = True
  End If
End With
With Range("A5")
lngLineFeedPosn = Instr(1,.Value,Chr(10))
  If lngLineFeedPosn > 0 Then  
    .Characters(1,Instr(1,.Value,Chr(10))).Font.Bold = True
  End If
End With
With Range("A6")
lngLineFeedPosn = Instr(1,.Value,Chr(10))
  If lngLineFeedPosn > 0 Then  
    .Characters(1,Instr(1,.Value,Chr(10))).Font.Bold = True
  End If
End With
End Sub

Het is waarschijnlijk niet de meest elegante oplossing maar het werkt wel

 

[edmoor]

@gast0660. Iets korter:

Sub BoldCell()
    For Each cl In Range("A1:A6")
        cl.Characters(1, InStr(1, cl.Value, Chr(10))).Font.Bold = True
    Next cl
End Sub

 

[gast0660]

@ Edmoor. idd ietsje korter:d:d:thumb:

 

[joskjos]

Super dit is wat ik bedoelde! Bedankt voor het meedenken!

Gr,
Jos

 

[joskjos]

De code van @edmoor werkt goed, alleen als ik weer de volgende tekst vernieuw in de cellen dan is de hele kolom nog Bold. Kan dit verandert worden zodat ik per keer dat ik de eerste regel tekst Bold wil hebben de knop indruk en dat daarna de kolom niet standaard op Bold blijft staan?

Gr,
Jos

 

[snb]

Ja hoor, dat kun je makkelijk zelf.