Note: The other languages of the website are Google-translated. Back to English

Hoe verplaats ik een hele rij naar een ander blad op basis van de celwaarde in Excel?

Voor het verplaatsen van een hele rij naar een ander blad op basis van de celwaarde, helpt dit artikel u.

Verplaats de hele rij naar een ander blad op basis van de celwaarde met VBA-code
Verplaats de hele rij naar een ander blad op basis van de celwaarde met Kutools voor Excel


Verplaats de hele rij naar een ander blad op basis van de celwaarde met VBA-code

Zoals onderstaand screenshot laat zien, moet u de hele rij verplaatsen van Blad1 naar Blad2 als een specifiek woord "Gereed" bestaat in kolom C. U kunt de volgende VBA-code proberen.

1. druk op anders+ F11 toetsen tegelijkertijd om het Microsoft Visual Basic voor toepassingen venster.

2. Klik in het venster Microsoft Visual Basic for Applications op Invoegen > Module. Kopieer en plak vervolgens de onderstaande VBA-code in het venster.

VBA code 1: Move entire row to another sheet based on cell value

Sub Cheezy()
'Updated by Kutools for Excel 2017/8/28
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Done" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Opmerking:: In de code, Sheet1 is het werkblad de rij die u wilt verplaatsen. En Sheet2 is het bestemmingswerkblad waar u de rij naartoe wilt lokaliseren. "C: C'Is de kolom die de bepaalde waarde bevat en het woord'gedaan”Is de bepaalde waarde waarop u de rij verplaatst op basis van. Wijzig ze op basis van uw behoeften.

3. druk de F5 toets om de code uit te voeren, dan wordt de rij die aan de criteria in Sheet1 voldoet onmiddellijk naar Sheet2 verplaatst.

Opmerking:: De bovenstaande VBA-code verwijdert rijen uit de originele gegevens nadat ze naar een opgegeven werkblad zijn verplaatst. Als u alleen rijen wilt kopiëren op basis van celwaarde in plaats van ze te verwijderen. Pas de onderstaande VBA-code 2 toe.

VBA code 2: Copy entire row to another sheet based on cell value

Sub MoveRowBasedOnCellValue()
'Updated by Extendoffice 2017/11/10
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Verplaats de hele rij naar een ander blad op basis van de celwaarde met Kutools voor Excel

Als je een newbie bent in VBA-code. Hier introduceer ik de Selecteer specifieke cellen nut van Kutools for Excel. Met dit hulpprogramma kunt u eenvoudig alle rijen selecteren op basis van een bepaalde celwaarde of verschillende celwaarden in een werkblad, en de geselecteerde rijen naar het doelwerkblad kopiëren als u nodig hebt. Ga als volgt te werk.

Voor het aanvragen Kutools for Excel, Dan kunt u download en installeer het eerst.

1. Selecteer de kolomlijst die de celwaarde bevat waarop u rijen wilt verplaatsen, en klik vervolgens op Kutools > kies > Selecteer specifieke cellen. Zie screenshot:

2. In de opening Selecteer specifieke cellen dialoogvenster, kies Hele rij functie in het Selectie type sectie, selecteer Is gelijk aan functie in het Specifiek type vervolgkeuzelijst, voer de celwaarde in het tekstvak in en klik vervolgens op het OK knop.

Nog een Selecteer specifieke cellen dialoogvenster verschijnt om u het aantal geselecteerde rijen te tonen, en ondertussen bevatten alle rijen de opgegeven waarde in de geselecteerde kolom zijn geselecteerd. Zie screenshot:

3. druk de Ctrl + C -toetsen om de geselecteerde rijen te kopiëren en ze vervolgens in het gewenste werkblad te plakken.

Opmerking:: Als u rijen naar een ander werkblad wilt verplaatsen op basis van twee verschillende celwaarden. Verplaats bijvoorbeeld rijen op basis van celwaarden "Gereed" of "Verwerken", u kunt de Or voorwaarde in de Selecteer specifieke cellen dialoogvenster zoals onderstaand screenshot getoond:

  Als u een gratis proefperiode (30 dagen) van dit hulpprogramma wilt, klik om het te downloaden, en ga vervolgens de bewerking toepassen volgens de bovenstaande stappen.


Gerelateerde artikelen:


De beste tools voor kantoorproductiviteit

Kutools voor Excel lost de meeste van uw problemen op en verhoogt uw productiviteit met 80%

  • visfuik: Snel invoegen complexe formules, grafieken en alles wat je eerder hebt gebruikt; Versleutel cellen met wachtwoord; Maak een mailinglijst en stuur e-mails ...
  • Super Formula-balk (bewerk eenvoudig meerdere regels tekst en formule); Lay-out lezen (gemakkelijk grote aantallen cellen lezen en bewerken); Plakken in gefilterd bereik...
  • Voeg cellen / rijen / kolommen samen zonder gegevens te verliezen; Gespleten cellen inhoud; Combineer dubbele rijen / kolommen... Voorkom dubbele cellen; Vergelijk Ranges...
  • Selecteer Dupliceren of Uniek Rijen; Selecteer lege rijen (alle cellen zijn leeg); Super zoeken en fuzzy zoeken in veel werkboeken; Willekeurige selectie ...
  • Exacte kopie Meerdere cellen zonder de formuleverwijzing te wijzigen; Maak automatisch verwijzingen naar meerdere bladen; Plaats kogels, Selectievakjes en meer ...
  • Extraheer tekst, Tekst toevoegen, Verwijderen op positie, Ruimte verwijderen; Paging-subtotalen maken en afdrukken; Converteren tussen celinhoud en opmerkingen...
  • Super filter (bewaar en pas filterschema's toe op andere bladen); Geavanceerd sorteren per maand / week / dag, frequentie en meer; Speciaal filter door vet, cursief ...
  • Combineer werkmappen en werkbladen; Tabellen samenvoegen op basis van sleutelkolommen; Gegevens splitsen in meerdere bladen; Batch Converteer xls, xlsx en PDF...
  • Meer dan 300 krachtige functies. Ondersteunt Office / Excel 2007-2019 en 365. Ondersteunt alle talen. Eenvoudig te implementeren in uw onderneming of organisatie. Gratis proefperiode van 30 dagen met volledige functies. 60 dagen geld-terug-garantie.
kte tabblad 201905

Office-tabblad Brengt een interface met tabbladen naar Office en maakt uw werk veel gemakkelijker

  • Schakel bewerken en lezen met tabbladen in Word, Excel, PowerPoint in, Publisher, Access, Visio en Project.
  • Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster in plaats van in nieuwe vensters.
  • Verhoogt uw productiviteit met 50% en vermindert elke dag honderden muisklikken!
officetab onderkant
Comments (287)
Nog geen beoordelingen. Beoordeel als eerste!
Deze opmerking is gemaakt door de moderator op de site
Hallo, ik vond deze specifieke gids erg nuttig in vergelijking met andere die ik heb gezien. Dank u! Het probleem dat ik heb, is dat als ik mijn gewenste waarde verander in 'Gesloten', ik F5 moet uitvoeren om de rij te verplaatsen. Ik zou graag willen dat het automatisch beweegt. Ik ben nieuw bij Excel, dus uw hulp wordt zeer op prijs gesteld. Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Worksheets("ECR Incident Tracker").UsedRange.Rows.Count J = Worksheets("Opgeloste problemen").UsedRange.Rows. Count If J = 1 Then If Application.WorksheetFunction.CountA(Worksheets("Opgeloste problemen").UsedRange) = 0 Then J = 0 End If Set xRg = Worksheets("ECR Incident Tracker").Range("B1:B" & I) Bij fout Volgende toepassing hervatten.ScreenUpdating = False voor elke xCell in xRg If CStr(xCell.Value) = "Closed" Then xCell.EntireRow.Copy Destination:=Worksheets("Opgeloste problemen").Range("A" & J + 1) xCell.EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub
Deze opmerking is gemaakt door de moderator op de site
Hallo, ik probeer het verplaatsen van de cellen te automatiseren zonder de module te openen en ook op F5 te drukken. Heb je deze vraag ooit opgelost? Dank u bij voorbaat!
Deze opmerking is gemaakt door de moderator op de site
Crystal heeft informatie gegeven over hoe je dat vandaag kunt doen - kijk op pagina één van deze thread om haar reactie te zien. Het verplaatst automatisch de rij met de datum van vandaag in een kolom (L in mijn geval) naar een ander werkblad.
Deze opmerking is gemaakt door de moderator op de site
Ik voer deze code uit en probeer een rij te verplaatsen op basis van de datum van vandaag die in kolom I verschijnt - ik heb Range ("B1:B" & I) gewijzigd om Range (I1:I" & I) te lezen. Ik heb gewijzigd " Klaar" in uw voorbeeld tot Datum. Wanneer de datum van vandaag echter ergens in de rij verschijnt, niet alleen in de I-kolom zoals vereist, wordt de rij verplaatst naar het alternatieve werkblad. Enig idee waarom dit gebeurt en hoe ik de rij kan laten verplaatsen alleen als de datum van vandaag in kolom I staat, ongeacht of de datum van vandaag in andere kolommen staat?
Deze opmerking is gemaakt door de moderator op de site
Als ik veel waarden en veel bladen wilde hebben om mijn rij naar te verplaatsen, zou ik dan de hele code opnieuw moeten schrijven met een andere waarde voor die cel? Dit betekent dat als ik NA in één cel zet, het naar het Na-blad gaat, en als ik W# plaats, gaat het naar het verkeerde cijferblad enz.
Deze opmerking is gemaakt door de moderator op de site
hallo, dit was erg nuttig. Is er een manier om dit te doen zonder de rij met gegevens naar het tweede blad te verplaatsen, maar deze te laten kopiëren? Dus de gegevens blijven op beide bladen staan?
Deze opmerking is gemaakt door de moderator op de site
Hallo, de code was erg nuttig, maar in plaats van de hele rij te kopiëren, moet een bepaalde selectie van de rij naar het volgende blad worden verplaatst. hoe kan ik een bereik definiëren in plaats van een hele rij Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Worksheets("Sheet1").UsedRange.Rows.Count J = Worksheets(" Blad2").UsedRange.Rows.Count If J = 1 Then If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0 End If Set xRg = Worksheets("Sheet1").Range( "C1:C" & I) Bij fout Volgende toepassing hervatten.ScreenUpdating = False voor elke xCell in xRg If CStr(xCell.Value) = "Klaar" Dan xCell.Hele rij.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1) J = J + 1 End If Next Application.ScreenUpdating = True End Sub
Deze opmerking is gemaakt door de moderator op de site
wat zou de code zijn als ik rijen (specifieke cellen) naar een ander blad naar specifieke cellen wil kopiëren? MAAR ook gebaseerd op een waarde Voorbeeld: kleur productafbeeldingen string witte blender 2 whiteblender2 zwarte juicer 3 blackjuicer3 rode tv 1 redtv1 groen strijkijzer 4 greeniron4 Ik zou de string naar een ander blad willen kopiëren, maar het nummer in de afbeeldingenkolom geeft aan hoe vaak het gekopieerd moet worden (dus in dit geval de blenderstring moet in 2 rijen worden gekopieerd
Deze opmerking is gemaakt door de moderator op de site
Hallo, Heel mooi stukje code, werkt heel goed. Hoe verander ik deze code om rijen van de ene tabel naar een andere tabel te verplaatsen, in plaats van van het ene blad naar het andere blad? Erg bedankt !
Deze opmerking is gemaakt door de moderator op de site
Hallo, ik probeer de code te gebruiken, maar ik ontvang een syntaxisfout op Dim xCell As Range. Kun je alsjeblieft helpen ?
Deze opmerking is gemaakt door de moderator op de site
Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Worksheets("Sheet1").UsedRange.Rows.Count J = Worksheets("Sheet2").UsedRange.Rows.Count If J = 1 Then If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0 End If Set xRg = Worksheets("Sheet1").Range("C1:C" & I) On Error Resume Volgende Application.ScreenUpdating = False voor elke xCell in xRg If CStr(xCell.Value) = "Klaar" Dan xCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1) xCell. EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub hoe kan een tweede werkblad worden toegevoegd om rijen naar blad2 te verplaatsen?
Deze opmerking is gemaakt door de moderator op de site
Wat moet ik invoeren als ik een datum als mijn waarde wil opnemen? Dus de rij blijft op blad 1 staan ​​als er geen datum staat, en gaat naar blad 2 als dat wel zo is?
Deze opmerking is gemaakt door de moderator op de site
[quote] hallo, dit was erg nuttig. Is er een manier om dit te doen zonder de rij met gegevens naar het tweede blad te verplaatsen, maar deze te laten kopiëren? Dus de gegevens blijven op beide bladen staan?Door Maddie[/quote] heeft iemand dit opgelost?
Deze opmerking is gemaakt door de moderator op de site
Verwijder deze "xCell.EntireRow.Delete" uit de code
Deze opmerking is gemaakt door de moderator op de site
Wanneer ik die regel code verwijder en de macro opnieuw uitvoer, loopt Excel vast. Waarom en hoe los ik het op?? Ik wil dat de gegevens op beide werkbladen staan ​​en niet uit het origineel worden verwijderd. TIA
Deze opmerking is gemaakt door de moderator op de site
is hier een antwoord op? De mijne loopt ook vast. Ik wil de rij kopiëren maar niet verwijderen
Deze opmerking is gemaakt door de moderator op de site
Good Day,
De onderstaande VBA-code kan u helpen om alleen de rijen te kopiëren in plaats van ze te verwijderen.

Sub Cheezy()
Dim xRg als bereik
Dim xCell als bereik
Dim ik zo lang
Dim J As Long
Dim K As Long
I = werkbladen ("Blad1"). Gebruikt bereik. Rijen. Aantal
J = Werkbladen ("Blad2"). Gebruikt bereik. Rijen. Aantal
Als J = 1 Dan
If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Dan J = 0
End If
Stel xRg = Werkbladen ("Blad1") in. Bereik ("C1:C" & I)
On Error Resume Next
Application.ScreenUpdating = False
Voor K = 1 tot xRg.Count
Als CStr(xRg(K).Waarde) = "Gereed" Dan
xRg(K).EntireRow.Copy Destination:=Werkbladen("Blad2").Bereik("A" & J + 1)
J = J + 1
End If
Volgende
Application.ScreenUpdating = True
End Sub
Deze opmerking is gemaakt door de moderator op de site
Hallo, ik ben op zoek naar een variatie hierop. Ik heb het script nodig om continu te draaien, of als dat niet lukt wanneer de waarde in dat specifieke veld verandert. De code zelf werkt, maar moet onafhankelijk worden uitgevoerd. Ik wil dat het geautomatiseerd wordt. Kan iemand helpen?

Even terzijde, als ik alleen wil dat het over specifieke cellen in het bereik kopieert, hoe wordt dat dan bereikt?
Deze opmerking is gemaakt door de moderator op de site
Beste Rob,

Als u wilt dat het script automatisch wordt uitgevoerd wanneer cellen in dat veld worden gewijzigd, kan de onderstaande VBA-code u helpen. Klik met de rechtermuisknop op het huidige blad (het blad met rijen dat u automatisch verplaatst) en selecteer vervolgens Bekijk code in het contextmenu. Kopieer en plak vervolgens het onderstaande VBA-script in het codevenster.

Particulier subwerkblad_Wijziging (ByVal-doel als bereik)

Dim xCell als bereik

Dim ik zo lang
On Error Resume Next

Application.ScreenUpdating = False

Stel xCell = Doel in (1)
Als xCell.Value = "Gereed" Dan
I = werkbladen ("Blad2"). Gebruikt bereik. Rijen. Aantal
Als ik = 1 Dan

If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Dan I = 0

End If

xCell.EntireRow.Kopieer werkbladen("Blad2").Bereik("A" & I + 1)

xCell.VolledigeRij.Verwijderen
End If

Application.ScreenUpdating = True

End Sub


Voor uw tweede vraag, bedoelt u dat u meerdere cellen kopieert in plaats van de hele rij? Of zou je een screenshot willen maken van je vraag? Dank u!

Met vriendelijke groeten, Crystal
Deze opmerking is gemaakt door de moderator op de site
Kristal,


Uw hulp is meer dan nodig :)



Hoe we hier nog een criterium kunnen toevoegen, ik wil bijvoorbeeld Voltooid naast Gereed overzetten:


Particulier subwerkblad_Wijziging (ByVal-doel als bereik)

Dim xCell als bereik

Dim ik zo lang
On Error Resume Next

Application.ScreenUpdating = False

Stel xCell = Doel in (1)
Als xCell.Value = "Gereed" Dan
I = werkbladen ("Blad2"). Gebruikt bereik. Rijen. Aantal
Als ik = 1 Dan

If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Dan I = 0

End If

xCell.EntireRow.Kopieer werkbladen("Blad2").Bereik("A" & I + 1)

xCell.VolledigeRij.Verwijderen
End If

Application.ScreenUpdating = True

End Sub
Deze opmerking is gemaakt door de moderator op de site
Hallo Kristal
Dit is de meest bruikbare informatie die ik op internet heb gevonden en deze macro doet wat ik wil. Maar ik verplaats de rijen van de ene tabel naar de andere - en met deze macro wordt de informatie verplaatst naar de eerste vrije regel buiten de tabel, niet naar de volgende vrije regel in de tabel? Kun je helpen?
Deze opmerking is gemaakt door de moderator op de site
Ik voer deze code uit en probeer een rij te verplaatsen op basis van de datum van vandaag die in kolom I verschijnt - ik heb Range ("B1:B" & I) gewijzigd om Range (I1:I" & I) te lezen. Ik heb gewijzigd " Klaar" in uw voorbeeld tot Datum. Wanneer de datum van vandaag echter ergens in de rij verschijnt, niet alleen in de I-kolom zoals vereist, wordt de rij verplaatst naar het alternatieve werkblad. Enig idee waarom dit gebeurt en hoe ik de rij kan laten verplaatsen alleen als de datum van vandaag in kolom I staat, ongeacht of de datum van vandaag in andere kolommen staat?
Deze opmerking is gemaakt door de moderator op de site
Beste David,

De code werkt goed voor mij na het wijzigen van het bereik en de variatiewaarde tot nu toe. Het datumformaat in uw code moet overeenkomen met het datumformaat dat u in het werkblad hebt gebruikt. Of is het handig om je werkblad bij te voegen?
Deze opmerking is gemaakt door de moderator op de site
Hallo Kristal,


Het is mij niet duidelijk wat u bedoelt als u zegt dat de datumnotaties van de code en de spreadsheet moeten overeenkomen - ik ben geen VB-expert, meer een beginner. In mijn spreadsheet vul ik de datum van vandaag in kolom F in als de invoerdatum van de rij, in het formaat ctrl + :. Ik vul de vervaldatum in kolom "I" in in het mm/dd/jjjj-formaat. Dit veroorzaakt echter problemen bij het maken van een nieuwe rij-invoer en het invoeren van de datum van vandaag in kolom F, omdat, zodra deze is ingevoerd, de rij naar het nieuwe werkblad wordt verplaatst. Bovendien wordt de extra code die moet worden uitgevoerd wanneer de werkmap wordt geopend, niet weergegeven rennen zonder dat ik het dwing. Sorry voor wat voor u misschien heel triviale problemen zijn, maar ik kan deze problemen gewoon niet begrijpen. Alle hulp zou op prijs worden gesteld.
Deze opmerking is gemaakt door de moderator op de site
Beste David,

Ik heb geprobeerd zoals precies wat je hierboven noemde, maar de probleemdosis verschijnt niet in mijn geval. Kunt u uw Excel-versie verstrekken? Ik heb meer informatie nodig om dit probleem op te lossen. Sorry dat ik je weer lastig val.

Met vriendelijke groeten, Crystal
Deze opmerking is gemaakt door de moderator op de site
Crystal, dit zijn de betreffende werkbladen. U zult in de gekopieerde code zien dat ik zoek naar "tot" de datum van vandaag in kolom L en als "tot" en inclusief de datum van vandaag in die kolom staat, dan wil ik de rij met die datum naar een nieuw werkblad verplaatsen. Als ik momenteel de datum van vandaag ergens in de rij invoer (bijvoorbeeld kolom F als er vandaag een verzoek wordt gedaan), wordt de hele rij automatisch naar de gearchiveerde spreadsheet verplaatst. Ik voer meestal de datum van vandaag in met de combinatie ctrl + : meestal in kolom F.
Bovendien zou ik willen dat deze beweging plaatsvindt wanneer ik de werkmap open. Momenteel moet ik naar de code gaan en vervolgens op F5 drukken. Elk advies over hoe dat te doen zou welkom zijn.
Deze opmerking is gemaakt door de moderator op de site
Helaas kan mijn werkmap met macro's niet worden geüpload omdat er staat dat het formaat niet wordt ondersteund. Deze staan ​​in Excel 2016
Deze opmerking is gemaakt door de moderator op de site
Beste David,

De volgende VBA-code kan u helpen dit te bereiken.

Private Sub Workbook_Open ()
Dim xRg als bereik
Dim xCell als bereik
Dim ik zo lang
Dim J As Long
I = Werkbladen ("HUIDIGE OASIS-MOGELIJKHEDEN").UsedRange.Rows.Count
J = Werkbladen ("ARCHIVEERDE OASIS-MOGELIJKHEDEN").UsedRange.Rows.Count
Als J = 1 Dan
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 Dan J = 0
End If
Stel xRg = Worksheets ("HUIDIGE OASIS-MOGELIJKHEDEN") in. Bereik ("L1:L" & I)
On Error Resume Next
Application.ScreenUpdating = False
Voor elke xCell In xRg
Als CStr(xCell.Value) = Datum Dan
xCell.EntireRow.Copy Destination:=Werkbladen ("ARCHIVEERDE OASIS-MOGELIJKHEDEN").Bereik ("A" & J + 1)
xCell.VolledigeRij.Verwijderen
J = J + 1
End If
Volgende
End Sub

Opmerkingen:
1. U moet het VBA-script in het ThisWorkbook-codevenster plaatsen;
2. Uw werkmap moet worden opgeslagen als Excel Macro-Enabled Workbook.

Na de bovenstaande bewerking wordt elke keer dat u de werkmap opent, een hele rij verplaatst naar het GEARCHIVEERD werkblad als de cel in kolom L de huidige datum bereikt.

Groetjes, Crystal
Deze opmerking is gemaakt door de moderator op de site
Bedankt Kristal,
Dit werkt prima als de datum van vandaag wordt bereikt in kolom L. Is er een manier om de datum van vandaag ook in kolom L op te nemen, zodat als ik een aantal dagen niet in de werkmap kijk, deze automatisch eerdere datums vóór die van vandaag? Heel erg bedankt voor je hulp.
Deze opmerking is gemaakt door de moderator op de site
Beste David,

Sorry, ik weet niet zeker of ik je vraag heb. Als dat het geval is, worden alle rijen verplaatst zolang eerdere datums in kolom L verschijnen?
Deze opmerking is gemaakt door de moderator op de site
Hallo Kristal,

Als ik mijn werkblad een paar dagen niet open en de datum die in kolom L is ingevoerd, is nu verstreken, dwz de datum in een cel in kolom L is 11 september 2017, maar ik open mijn werkblad pas op 13 september, dan zou ik zoals alle vermeldingen in kolom L die moeten worden gecontroleerd voor elke datum tot de datum van vandaag, verplaats dan de overeenkomstige rijen naar het nieuwe blad. Momenteel worden met de code die u genadig hebt verstrekt, alleen rijen met de huidige datum in kolom L verplaatst naar het nieuwe blad, waarbij de rijen met een eerdere datum in kolom L achterblijven, die ik momenteel handmatig naar het nieuwe blad verplaats. Bedankt voor je hulp.
Deze opmerking is gemaakt door de moderator op de site
Beste David,



Ik snap je punt. Probeer het onderstaande VBA-script. Wanneer u de werkmap opent, worden alle rijen met datums tot de datum van vandaag in kolom L verplaatst naar een nieuw gespecificeerd blad.



Private Sub Workbook_Open ()
Dim xRg als bereik
Dim xRgRtn als bereik
Dim xCell als bereik
Dim xLaatste Rij Zo Lang
Dim ik zo lang
Dim J As Long
On Error Resume Next
xLastRow = Werkbladen ("HUIDIGE OASIS-MOGELIJKHEDEN").UsedRange.Rows.Count
Als xLastRow < 1 Sub afsluiten
J = Werkbladen ("ARCHIVEERDE OASIS-MOGELIJKHEDEN").UsedRange.Rows.Count
Als J = 1 Dan
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 Dan J = 0
End If
Set xRg = Worksheets("HUIDIGE OASIS MOGELIJKHEDEN").Bereik("L1:L" & xLastRow)
Voor I = 2 Tot xLaatste Rij
Als xRg(I).Waarde > Datum, dan Sub afsluiten
Als xRg(I).Waarde <= Datum Dan
xRg(I).EntireRow.Copy Destination:=Werkbladen("ARCHIVEERDE OASIS-MOGELIJKHEDEN").Bereik ("A" & J + 1)
xRg(I).VolledigeRij.Verwijderen
J = J + 1
ik = ik - 1
End If
Volgende
End Sub

U moet het VBA-script in het ThisWorkbook-codevenster plaatsen en de werkmap opslaan als een Excel-werkmap met macro's.
Deze opmerking is gemaakt door de moderator op de site
Bedankt Crystal, dat werkt prima.
Deze opmerking is gemaakt door de moderator op de site
Crystal, ik was een beetje haastig om te antwoorden dat de code werkte. Ik heb vandaag mijn werkmap geopend en rijen met eerdere datumvermeldingen in kolom L-cel bevinden zich nog steeds in het "huidige oase-werkblad" en zijn niet zoals verwacht verplaatst naar het "gearchiveerde oase-werkblad". Enig idee waarom dit het geval zou zijn?
Deze opmerking is gemaakt door de moderator op de site
De gemarkeerde cellen bevinden zich in kolom L met betrekking tot de bovenstaande vraag en zijn de criteria (tot de datum van vandaag) om de rij naar het nieuwe werkblad te verplaatsen. Ik hoop dat deze afbeelding helpt.
Deze opmerking is gemaakt door de moderator op de site
Dit is ook een kopie van het VBA-venster met betrekking tot het bovenstaande.
Deze opmerking is gemaakt door de moderator op de site
Crystal, ik was een beetje haastig om te antwoorden dat de code werkte. Ik heb vandaag mijn werkmap geopend en rijen met eerdere datumvermeldingen in kolom L-cel bevinden zich nog steeds in het "huidige oase-werkblad" en zijn niet zoals verwacht verplaatst naar het "gearchiveerde oase-werkblad". Enig idee waarom dit het geval zou zijn?
Deze opmerking is gemaakt door de moderator op de site
Kristal,

Aangezien ik mijn werkmap niet kan uploaden, zal ik de rijen en kolommen hier reproduceren

ABCDEFGHIJKL
# Type Braaklegging Verzoek Wijziging # Uitgiftedatum Vragen Klant Levering Locatie Projectvoorstel Verplicht

1 SS SB 1234567 1 09/6/17 Geen Legernaam Plaats Aandrijftank 09/10/17

Met behulp van de onderstaande code wil ik dat deze een hele rij naar een nieuw werkblad verplaatst wanneer kolom L de datum van vandaag bereikt. Ook als ik het werkblad een aantal dagen niet heb ingevuld, zou ik willen dat het de zoekfunctie "tot de datum van vandaag" in kolom L gebruikt om hetzelfde te doen. Ik zou ook willen dat dit indien mogelijk automatisch wordt gedaan wanneer ik de werkmap open. Als ik momenteel de datum van vandaag in een cel in de rij invoer, bijvoorbeeld kolom F bij het invoeren van gegevens, wordt de hele rij verplaatst naar het archiefwerkblad. (Met Excel 2016)

[Module 1-code]

Sub DaveV()

Dim xRg als bereik

Dim xCell als bereik

Dim ik zo lang

Dim J As Long

I = Werkbladen ("HUIDIGE OASIS-MOGELIJKHEDEN").UsedRange.Rows.Count

J = Werkbladen ("ARCHIVEERDE OASIS-MOGELIJKHEDEN").UsedRange.Rows.Count

Als J = 1 Dan
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 Dan J = 0

End If

Stel xRg = Worksheets ("HUIDIGE OASIS-MOGELIJKHEDEN") in. Bereik ("L1:L" & I)

On Error Resume Next

Application.ScreenUpdating = False

Voor elke xCell In xRg

Als CStr(xCell.Value) = Datum Dan

xCell.EntireRow.Copy Destination:=Werkbladen ("ARCHIVEERDE OASIS-MOGELIJKHEDEN").Bereik ("A" & J + 1)
xCell.VolledigeRij.Verwijderen

J = J + 1
End If

Volgende
Application.ScreenUpdating = True

End Sub
Deze opmerking is gemaakt door de moderator op de site
[Blad 1 code]

Particulier subwerkblad_Wijziging (ByVal-doel als bereik)
Dim xCell als bereik
Dim ik zo lang
On Error Resume Next
Application.ScreenUpdating = False
Stel xCell = Doel in (1)
Als xCell.Value = Datum Dan
I = werkbladen ("ARCHIVEERDE OASIS-MOGELIJKHEDEN").UsedRange.Rows.Count
Als ik = 1 Dan
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 Then I = 0 End If
xCell.EntireRow.Copy Worksheets("ARCHIVEERDE OASIS MOGELIJKHEDEN").Bereik("A" & I + 1)
xCell.VolledigeRij.Verwijderen
End If
Application.ScreenUpdating = True
End Sub

Ik hoop dat het bovenstaande helpt, maar ik ben geen VBA-persoon en begrijp daarom niet hoe ik de code kan laten doen wat ik nodig heb. Uw hulp zou op prijs worden gesteld.
Deze opmerking is gemaakt door de moderator op de site
Er staat een grote fout in je script!

Stel dat je hebt ontdekt dat rij 7 het woord "Klaar" bevat in kolom C, dus kopieer je het en verwijder je de rij.
Nadat u de rij hebt verwijderd, is de volgende rij in de lijst rij 9 en niet 8, want zodra u de 7e regel hebt verwijderd, staat nu de inhoud van de 8e regel in regel 7 en zijn alle regels 1 rij omhoog gegaan. Dus de volgende rij om te controleren zou rij #8 zijn, maar nu bevat het de gegevens die voorheen op rij #9 stonden, dus elke keer dat je een rij verwijdert, sla je eigenlijk een rij over om te controleren!!!
Deze opmerking is gemaakt door de moderator op de site
Beste Shau Alon,

Bedankt voor je reactie. De code is bijgewerkt en de fout is verholpen. Heel erg bedankt voor je assistent.

Met vriendelijke groeten, Crystal
Deze opmerking is gemaakt door de moderator op de site
Ik denk dat dit met mij gebeurt, het blijft dezelfde rij steeds opnieuw kopiëren, ook al staat er dat de code is bijgewerkt. Dit is wat ik heb:

Sub Cheezy()
'Bijgewerkt door Kutools voor Excel 2017/8/28
Dim xRg als bereik
Dim xCell als bereik
Dim ik zo lang
Dim J As Long
Dim K As Long
I = werkbladen ("AANKOOP FORCAST").UsedRange.Rows.Count
J = Werkbladen ("Aankooparchief").UsedRange.Rows.Count
Als J = 1 Dan
If Application.WorksheetFunction.CountA(Worksheets("Purchase Archive").UsedRange) = 0 Dan J = 0
End If
Stel xRg = Worksheets ("AANKOOP FORCAST") in. Bereik ("H3:H" & I)
On Error Resume Next
Application.ScreenUpdating = False
Voor K = 1 tot xRg.Count
Als CStr(xRg(K).Waarde) = "Ja" Dan
xRg(K).EntireRow.Copy Destination:=Werkbladen("Aankooparchief").Bereik("A" & J + 1)
xRg(K).VolledigeRij.Verwijderen
Als CStr(xRg(K).Waarde) = "Ja" Dan
K = K - 1
End If
J = J + 1
End If
Volgende
Application.ScreenUpdating = True
End Sub
Deze opmerking is gemaakt door de moderator op de site
Hallo Fred,
Elke keer dat u de code uitvoert, zoekt de code naar het opgegeven bereik, zodat dezelfde rij steeds opnieuw wordt gekopieerd omdat hij niet kan zien welke rij al is gekopieerd. Om te voorkomen dat dezelfde rij herhaaldelijk wordt gekopieerd, kunt u de code automatisch laten uitvoeren wanneer een overeenkomende waarde in de opgegeven cel wordt ingevoerd.
In het werkblad met de naam "AANKOOP FORCAST", klik met de rechtermuisknop op de bladtab en klik op Bekijk code vanuit het contextmenu. Kopieer vervolgens de volgende VBA-code in het venster Blad (code).

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated by Kutools for Excel 20220830
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("PURCHASE FORCAST").UsedRange.Rows.Count
J = Worksheets("Purchase Archive").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Purchase Archive").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("PURCHASE FORCAST").Range("H3:H" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Yes" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Purchase Archive").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Yes" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub
Deze opmerking is gemaakt door de moderator op de site
Zou iemand mij kunnen helpen dit te laten werken? Ik heb geprobeerd het deel te wijzigen dat moet overeenkomen met mijn bestand, maar dit komt naar voren en ik weet niet zeker wat ik moet doen.
Deze opmerking is gemaakt door de moderator op de site
het zegt bestand niet ondersteund wanneer ik probeer het Excel-bestand te uploaden. Sorry... worstel hier vandaag mee.
Deze opmerking is gemaakt door de moderator op de site
Ik zou graag hulp willen voor een soortgelijke taak, maar dan net even anders. Ik heb 5 kolommen met getallen, ongeveer 25000 per kolom, elke kolom met een kop 1-5. Ik zou de hele rij naar een ander blad willen kopiëren als de waarde van kolom 1 groter is dan nul, OF kolom 2 groter is dan nul , OF kolom 3 is kleiner dan nul, OF kolom 4 is groter dan vijf OF kolom 5 is groter dan twee enz. is dit mogelijk?
Deze opmerking is gemaakt door de moderator op de site
afbeelding uploaden werkt niet... sorry.
Deze opmerking is gemaakt door de moderator op de site
Hallo,
Gebruik de upload-knop van deze.
Deze opmerking is gemaakt door de moderator op de site
Het doel is dus om te zien of een van de gassen een limiet overschrijdt die ik in de formule zal instellen, de hele ree wordt op een nieuw blad GEKOPIEERD.

Heel erg bedankt voor alle hulp.
Deze opmerking is gemaakt door de moderator op de site
Afbeelding bijgevoegd
Deze opmerking is gemaakt door de moderator op de site
Beste Michael,
Misschien kunt u dit probleem oplossen door een Excel-invoegtoepassing te gebruiken. Hier raad ik u het Selecteer specifieke cellen nut van Kutools voor Excel aan. Met dit hulpprogramma kunt u eenvoudig alle rijen in een bepaald bereik selecteren als de waarde van een opgegeven kolom groter of kleiner is dan een getal. Nadat u alle benodigde rijen hebt geselecteerd, kunt u ze handmatig kopiëren en in een nieuw werkblad plakken. Zie onderstaande bijgevoegde afbeelding.

U kunt meer over deze functie weten door de onderstaande hyperlink te volgen.
https://www.extendoffice.com/product/kutools-for-excel/excel-select-specific-cells-rows.html
Deze opmerking is gemaakt door de moderator op de site
bedankt voor deze formule, maar ik had een probleem dat wanneer ik de rij naar een ander blad wil verplaatsen, dit niet automatisch gebeurt. kun je me een andere formule geven? dus telkens wanneer ik de waarde van de cel verander, bewoog het automatisch.


bedankt
Deze opmerking is gemaakt door de moderator op de site
Beste Janang,
De codedosis gebeurt niet automatisch totdat u de run-knop handmatig activeert.
Deze opmerking is gemaakt door de moderator op de site
Hoi,

Ik zou deze macro willen hebben, maar met 2 argumenten. Het is me gelukt om de macro in mijn bestand te laten werken op basis van de waarde van de cellen in kolom O. Ik zou echter willen dat de macro ook controleert of kolom S is ingevuld (of <> "") voordat de rij wordt verplaatst . Ten slotte zou ik ook graag willen dat de gekopieerde rijen dezelfde opmaak hebben als de rijen in het tweede blad. Verandert dat de macro volledig?
Deze opmerking is gemaakt door de moderator op de site
Beste Hugo,
Ik weet niet of ik je goed begrijp. Je bedoelt dat als cel in kolom S is ingevuld en cel in kolom O tegelijkertijd de bepaalde waarde bevat, de rij dan met opmaak wordt verplaatst? Anders niet bewegen?
Deze opmerking is gemaakt door de moderator op de site
Hallo Kristal,

Ja dat is precies wat ik bedoel. In feite gaan mijn gegevens over projecten. Mijn kolom O is de status van mijn project en S de einddatum van mijn project.
Ik wil dat mijn gebruikers, de mensen die de informatie hebben en deze moeten invoegen, een project ALLEEN kunnen "archiveren" als ze de status "Gesloten" hebben en een "Einddatum" hebben ingevoerd.


Ik hoop dat dit helpt om dingen te verduidelijken
Deze opmerking is gemaakt door de moderator op de site
Beste Hugo,
Sorry dat ik zo laat reageer. De volgende VBA-code kan u helpen het probleem op te lossen. Volg de stappen in dit artikel om het VBA-script toe te passen.

Sub MoveRowBasedOnCellValue()
Dim xRgStatus als bereik
Dim xRgDate als bereik
Dim ik zo lang
Dim J As Long
Dim K As Long
I = werkbladen ("Blad1"). Gebruikt bereik. Rijen. Aantal
J = Werkbladen ("Blad2"). Gebruikt bereik. Rijen. Aantal
Als J = 1 Dan
If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Dan J = 0
End If
Stel xRgStatus = Werkbladen ("Blad1") in. Bereik ("O1:O" & I)
Stel xRgDate = Werkbladen ("Blad1") in. Bereik ("S1:S" & I)
On Error Resume Next
Application.ScreenUpdating = False
Application.CutCopyMode = False
xRgStatus(1).Gehele rij.Kopie
Werkbladen ("Blad2").Bereik ("A" & J + 1).Plakken Speciaal xlPlakkenAllesGebruikenBronThema
J = J + 1
Voor K = 2 tot xRgStatus.Count
Als CStr(xRgStatus(K).Value) = "Gesloten" Dan
If (xRgDate(K).Value <> "") And (TypeName(xRgDate(K).Value) = "Date") Dan
xRgStatus(K).VolledigeRij.Kopie
Werkbladen ("Blad2").Bereik ("A" & J + 1).Plakken Speciaal xlPlakkenAllesGebruikenBronThema
J = J + 1
End If
End If
Volgende
Application.CutCopyMode = True
Application.ScreenUpdating = True
End Sub
Deze opmerking is gemaakt door de moderator op de site
Beste kristal,

Heel erg bedankt voor uw hulp!

Met vriendelijke groet,

Hugues
Deze opmerking is gemaakt door de moderator op de site
Hallo,


Hoe kopieer ik de rijen in plaats van ze te verplaatsen?
Deze opmerking is gemaakt door de moderator op de site
Hallo,


Ik weet dat dit al een paar keer is gepost, maar ik kan het antwoord niet vinden. Hoe kan ik het materiaal naar het nieuwe blad kopiëren en het NIET van het originele blad verwijderen?
Deze opmerking is gemaakt door de moderator op de site
Beste Mike,
Als u de rijen wilt kopiëren in plaats van ze te verwijderen, kan de onderstaande VBA-code u helpen. Bedankt voor je reactie!

Sub Cheezy()
Dim xRg als bereik
Dim xCell als bereik
Dim ik zo lang
Dim J As Long
Dim K As Long
I = werkbladen ("Blad1"). Gebruikt bereik. Rijen. Aantal
J = Werkbladen ("Blad2"). Gebruikt bereik. Rijen. Aantal
Als J = 1 Dan
If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Dan J = 0
End If
Stel xRg = Werkbladen ("Blad1") in. Bereik ("C1:C" & I)
On Error Resume Next
Application.ScreenUpdating = False
Voor K = 1 tot xRg.Count
Als CStr(xRg(K).Waarde) = "Gereed" Dan
xRg(K).EntireRow.Copy Destination:=Werkbladen("Blad2").Bereik("A" & J + 1)
J = J + 1
End If
Volgende
Application.ScreenUpdating = True
End Sub
Deze opmerking is gemaakt door de moderator op de site
Hoi,

Ik ben nieuw in het gebruik van macro's, is het mogelijk om de onderstaande gegevens na een bepaalde waarde te plakken en worden deze herhaald tot het einde van de kolom?
Soortgelijk:

Breng "Blauw" over na "Kleur"

A1 = Blauw
A5= Kleur
A6= (hier "Blauw" overschrijven)
en zo verder ...
Deze opmerking is gemaakt door de moderator op de site
Dear John,
Bedoel je dat als een cel "Kleur" in een kolom bevat, dan de tekst van de eerste cel naar de cel onder de "Kleur" kopieert en deze tekst herhaalt tot het einde van de kolom?
Er zijn nog geen reacties geplaatst
Laad meer
Laat uw commentaar
Posten als gast
×
Beoordeel dit bericht:
0   Personages
Voorgestelde locaties