waarden copieren naar specifieke plek ander blad

[lsp1972]

Goedemorgen

ik heb een heel groot excel bestand waar meerdere mensen aan werken. Ik laat in een tabblad een specifieke lijst opbouwen, waar in een cel notities laat zetten.
Deze notities wil ik opslaan op een specifieke plek behorende bij die regel in de master file en dan de gevulde notities in de gemaakte lijst wissen.

zodat een volgende weer zijn eigen specifieke lijst kan maken, dit doe ik in de originele file door een selectie uit een selectielijst te maken.

Hopelijk is het bestandje duidelijk…

alvast bedankt voor het duwtje in de juiste richting

 

[JEC.]

Voor I3:

=ALS.FOUT(INDEX(filterblad!$F$3:$F$8;VERGELIJKEN('Grote bestand'!D3;filterblad!$B$3:$B$8;0));"")

En dan deze in de cell eigenschappen.

0;-0;;@

 

[lsp1972]

super dat werkt voor het kopiëren, echter als ik nu het filterblad bewerk, zijn die waarden weer weg.

Ik zou dus graag die gekopieerde waarden "vast zetten" na invoer.

 

[JEC.]

Is het per specifieke naam 1 notitie of volgen daarna nog meer notities voor eenzelfde naam. Als het bij eentje blijft kan je deze gebruiken. Dus eerst de formule volledig doortrekken en vervolgens kun je deze code runnen

Sub a()
lastrow = Sheets(2).Cells(Rows.Count, 2).End(xlUp).Row
lastrow2 = Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
For i = 3 To lastrow
    If Sheets(2).Range("I" & i) <> "" And Sheets(2).Range("I" & i) <> 0 Then
        Sheets(2).Range("I" & i) = Sheets(2).Range("I" & i).Value
    End If
Next i
Sheets(1).Activate
Range(Cells(3, 6), Cells(lastrow2, 6)).ClearContents
End Sub

 

[lsp1972]

Er is 1 regel en dus 1 notitie cel per uniek nummer.

Hij runt hem wel, maar ik krijg een foutmelding in de debugger op deze lijn.. [code voor het wissen van de waarden in kolom]

Sheets(1).Range(Cells(3, 6), Cells(lastrow2, 6)).ClearContents

En zou ik voor gemak ook de tab namen in de code kunnen gebruiken?

 

[JEC.]

Hij is aangepast. Je moet even die nieuwe pakken

 

[JEC.]

Met tabbladnamen:

Sub a()
lastrow = Sheets("Grote bestand").Cells(Rows.Count, 2).End(xlUp).Row
lastrow2 = Sheets("filterblad").Cells(Rows.Count, 2).End(xlUp).Row
For i = 3 To lastrow
    If Sheets("Grote bestand").Range("I" & i) <> "" And Sheets("Grote bestand").Range("I" & i) <> 0 Then
        Sheets("Grote bestand").Range("I" & i) = Sheets("Grote bestand").Range("I" & i).Value
    End If
Next i
Sheets("filterblad").Activate
Range(Cells(3, 6), Cells(lastrow2, 6)).ClearContents
End Sub

 

[VenA]

Zonder formules en onafhankelijk van de sortering.

Sub VenA()
  ar = Sheets("filterblad").Cells(2, 1).CurrentRegion
  ar1 = Sheets("Grote bestand").Cells(2, 1).CurrentRegion
  For j = 2 To UBound(ar)
    If ar(j, 6) <> "" Then
      For jj = 2 To UBound(ar1)
        If ar(j, 2) = ar1(jj, 4) Then
          ar1(jj, 9) = Trim(ar1(jj, 9) & " " & ar(j, 6))
          ar(j, 6) = ""
          Exit For
        End If
      Next jj
    End If
  Next j
  Sheets("Grote bestand").Cells(2, 1).CurrentRegion = ar1
  Sheets("filterblad").Cells(2, 1).CurrentRegion = ar
End Sub

 

[lsp1972]

Super! hartelijk dank beiden..

het werkt :thumb: