Voorwaarde Cel Rij kopieren

[Roeijoen]

Beste Forumleden,

ik moet een goede manier zien te vinden om een cel met een waarde "X" in een ander tabblad te zetten. ik zat er eerst aan te denk om dit te doen met Auto Row Filter en het met handwerk te doen maar nu wil ik dat Automatischeren.

misschien kunnen jullie mij daar bij helpen, want kom heel veel dingen tegen op het forum maar krijg niks goed werkend.

in de bijlage heb ik een bestand gezet met de waardes.
Bekijk bijlage Voorbeeld.xlsx

in kolom B staat bijvoorbeeld functie Hardware Engineer en die moeten in Tabblad Hardware Engineer komen.
en daarbij wil ik dat de hele Rij word gekopieerd en vanaf onder word geplaatst

Met Vriendelijke Groet,

Jeroen

 

[gast0660]

Hoi,
Werkt zoiets voor u?
Zie vbtje

 

[Roeijoen]

Werkt echt al Super,

Nu heb ik nog een vraagje kom er net achter dat het niet handig is om de hele rij te kopiëren maar kan beter een cel range aangeven.

Private Sub dotchie_Click()
Dim lRow, cRow As Long
lRow = Sheets("Namen").Range("F50000").End(xlUp).Row

For j = lRow To 1 Step -1

    If Sheets("Namen").Range("F" & j) = "Reheater" Then
        cRow = Sheets("Reheater").Range("A50000").End(xlUp).Row
        Sheets("Namen").Rows(j).Copy Destination:=Sheets("Reheater").Range("A" & cRow + 1)
        'Sheets("Namen").Rows(j).Delete
    
    ElseIf Sheets("Namen").Range("F" & j) = "Room Controller" Then
        cRow = Sheets("Room Controller").Range("A50000").End(xlUp).Row
        Sheets("Namen").Rows(j).Copy Destination:=Sheets("Room Controller").Range("A" & cRow + 1)
        'Sheets("Namen").Rows(j).Delete
    
    ElseIf Sheets("Namen").Range("F" & j) = "VAV-Valve" Then
        cRow = Sheets("VAV-Valve").Range("A50000").End(xlUp).Row
        Sheets("Namen").Rows(j).Copy Destination:=Sheets("VAV-Valve").Range("A" & cRow + 1)
        'Sheets("Namen").Rows(j).Delete
        
    ElseIf Sheets("Namen").Range("F" & j) = "Closing- / VAV-Valve" Then
        cRow = Sheets("VAV-Valve").Range("A50000").End(xlUp).Row
        Sheets("Namen").Rows(j).Copy Destination:=Sheets("VAV-Valve").Range("A" & cRow + 1)
        'Sheets("Namen").Rows(j).Delete
        
    ElseIf Sheets("Namen").Range("F" & j) = "Preheater" Then
        cRow = Sheets("Preheater").Range("A50000").End(xlUp).Row
        Sheets("Namen").Rows(j).Copy Destination:=Sheets("Preheater").Range("A" & cRow + 1)
        'Sheets("Namen").Rows(j).Delete
        
        ElseIf Sheets("Namen").Range("F" & j) = "Pressure Switch" Then
        cRow = Sheets("Air Handling Unit").Range("A50000").End(xlUp).Row
        Sheets("Namen").Rows(j).Copy Destination:=Sheets("Air Handling Unit").Range("A" & cRow + 1)
        'Sheets("Namen").Rows(j).Delete
    End If
Next

End Sub

kan ik dat dan aanpassen door

deze te vervangen Sheets("Namen").Rows(j) in Sheets("Namen").Cell(j)

 

[HSV]

Meer heb je niet nodig.

Private Sub dotchie_Click()
Dim sh As Worksheet
Application.ScreenUpdating = False
With Cells(1).CurrentRegion
 For Each sh In Sheets
 If Not sh.Name = "Namen" Then
    .AutoFilter 1, sh.Name
    .Offset(1).Copy sh.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    .AutoFilter
  End If
 Next sh
.Offset(1).ClearContents
End With
End Sub

 

[Roeijoen]

Goedemorgen,

Waar ik nu nog tegenaanloop is dat ik een rij cellen wil kopieren. ipv de hele rij zodat ik nog wat formules in de databladen kan zetten iemand een idee? hoe ik die Rows om kan zetten naar Cellen. heb van alles geprobeerd maar word er niet wijzer uit.

Thanks