Inhoud 1e cel uit regel kopieren

[jelle87]

Goedenmiddag,

Een hele poos geleden heb ik via dit forum hulp gehad, om in een Excel sheet de inhoud uit de 1e cel te kopieren, wanneer die regel geselecteerd is. Dus bijvoorbeeld, Cel F5 is geselecteerd, waarna automatisch de inhoud van cel A5 naar het klembord wordt gekopieerd.

Daar gebruik ik deze code voor:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'gegevens uit 1e cel kopieren naar het klembord

Dim DataObj As New MSForms.DataObject

DataObj.SetText Cells(ActiveCell.Row, 1)
DataObj.PutInClipboard
End Sub

Zie bijlage voor een voorbeeldbestand.

Ik heb toen ook begrepen om via de VBA Editor een verwijzing te activeren: 'Microsoft Forms 2.0 Object Library'. (zie ook bijlage)

Nu werkt het op mijn pc prima, maar op de pc van mijn collega niet. Als daar geplakt wordt, dan komen er 2 vraagtekens (??) te staan Terwijl de instellingen exact hetzelfde lijken te zijn. Heeft iemand een idee waar dit aan kan liggen?

 

[JEC.]

Probeer het eens zo. Dan heb je ook de library niet nodig.

Sub jvr()
  With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .SetText ActiveCell
    .PutInClipboard
  End With
End Sub

 

[jelle87]

Ik doe ongetwijfeld iets fout, want het werk niet helemaal lekker haha;

 

[JEC.]

Als je de code gewoon achter een module zet(rechtermuisknop en invoegen module), vervolgens op cel B2 gaat staan en de macro runt.
Dan wordt de waarde van B2 in het klembord gezet.

 

[jelle87]

Ik zou graag willen dat hij altijd 'aan staat', op bepaalde tabbladen. Dus niet dat hij nog handmatig geactiveerd moet worden.

Daarnaast moet hij eigenlijk altijd de cel uit Kolom A kopiëren, ongeacht welke kolom geselecteerd is. Dus als bijvoorbeeld:
D5 geselecteerd, dan moet A5 gekopieerd worden
H29 geselecteerd, dan moet A29 gekopieerd worden
etc.

 

[JEC.]

Zet deze dan achter je ThisWorkbook module

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  If Sh.Index <> 2 Then       'zorgt er bijvoorbeeld voor dat de macro niet werkt op tabblad 2
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
      .SetText Cells(target.Row, 1)
      .PutInClipboard
    End With
  End If
End Sub

 

[jelle87]

Ja, dat moet hem worden denk ik!

Stel dat ik nou dit alleen wil toepassen op Tabblad 1, 2 en 3, hoe doe ik dat dan ?

 

[JEC.]

If Sh.Index < 4 Then

if sh.index = 1 or sh.index = 2 etc...

of

If IsNumeric(Application.Match(Sh.Index, Array(1, 2, 4, 6), 0)) Then

 

[jelle87]

Sorry, daar was ik ook net achter gekomen, iets te snel gevraagd.

Hoe doe ik het dan op tab 1, 2, 4 en 6 bijvoorbeeld?

 

[jelle87]

Bedankt JV, het werkt top

Nu heb ik een ander probleem. Op 1 van de pc's hier, werkt het om de een of andere reden niet. Het resultaat wat daar weergegeven wordt als je plakt, zijn 2 vraagtekens (zie bijlage).

Alle pc's werkt het zoals het zou moeten, alleen op deze specifieke pc dus niet. Enig idee waar dat aan zou kunnen liggen?