Note: The other languages of the website are Google-translated. Back to English
Inloggen  \/ 
x
or
x
Registreer  \/ 
x

or

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 voor u!
officetab onderkant
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    jorgegui1 · 2 months ago
    Hi Crystal,

    In this part of the code:

    xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)

    Does the "A" refer to the column that will be copied into sheet2?

    I'm trying to copy in column B, but I'm not succeeding.
    • To post as a guest, your comment is unpublished.
      crystal · 1 months ago
      Hi,
      This part of code represents the destination where to place the copied values.
      If you want to copy rows based on values in column B, change the "C" to "B" in this part of the code:
        Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
  • To post as a guest, your comment is unpublished.
    kevin · 2 months ago
    Hey,

    Thanks for the code, 1 question is it possible to change it so i searches 2 diff values? No i use 2 macro to run after each other, but this slows my file down. 
    • To post as a guest, your comment is unpublished.
      crystal · 2 months ago
      Hi kevin,
      The below code handles 2 different values: Supposing rows in Sheet1 will be moved automatically based on two values "LIVE" and "ENDED" in column C. After running the code, the row containing "LIVE" goes to "Sheet2", and the row containing "ENDED" goes to "Sheet3".

      Sub Cheezy() 'Updated by Extendoffice 20210806 Dim xRg As Range Dim xCell As Range Dim xRRg1 As Range Dim xRRg2 As Range Dim xDWS As Worksheet Dim xLWS As Worksheet Dim xEWS As Worksheet Dim xDR, xLR, xER As Long Dim xDC As Long Dim K As Long Dim xC1 As Long Dim xFNum As Long Set xDWS = Worksheets("Sheet1") Set xLWS = Worksheets("Sheet2") 'LIVE Set xEWS = Worksheets("Sheet3") 'ENDED xDR = xDWS.UsedRange.Rows.count xLR = xLWS.UsedRange.Rows.count xER = xEWS.UsedRange.Rows.count xDC = xDWS.UsedRange.Columns.count If xLR = 1 Then If Application.WorksheetFunction.CountA(xLWS.UsedRange) = 0 Then xLR = 0 End If If xER = 1 Then If Application.WorksheetFunction.CountA(xEWS.UsedRange) = 0 Then xER = 0 End If Set xRg = xDWS.Range("C1:C" & xDR) On Error Resume Next Application.ScreenUpdating = False For K = 1 To xRg.count If CStr(xRg(K).Value) = "LIVE" Then Set xRRg1 = xRg(K).EntireRow Set xRRg2 = xLWS.Range("A" & xLR + 1).EntireRow For xFNum = 1 To xDC xRRg2.Value = xRRg1.Value Next xFNum xRg(K).EntireRow.Delete xLR = xLR + 1 ElseIf CStr(xRg(K).Value) = "ENDED" Then Set xRRg1 = xRg(K).EntireRow Set xRRg2 = xEWS.Range("A" & xER + 1).EntireRow For xFNum = 1 To xDC xRRg2.Value = xRRg1.Value Next xFNum xRg(K).EntireRow.Delete xER = xER + 1 End If Next K Application.ScreenUpdating = True End Sub
      • To post as a guest, your comment is unpublished.
        kevin · 2 months ago
        thx this xas verry helpfull!!!
  • To post as a guest, your comment is unpublished.
    Masouddodangeh · 3 months ago
    hello
    check this code plz
    Sub macro()

    Dim xRg As Range
    Dim xCell As Range
    Dim xRRg1 As Range
    Dim xRRg2 As Range

    Dim xAAWS As Worksheet
    Dim xAWS As Worksheet
    Dim xBWS As Worksheet
    Dim xCWS As Worksheet
    Dim xDWS As Worksheet
    Dim xEWS As Worksheet
    Dim xFWS As Worksheet
    Dim xGWS As Worksheet
    Dim xHWS As Worksheet
    Dim xIWS As Worksheet
    Dim xJWS As Worksheet
    Dim xKWS As Worksheet
    Dim xLWS As Worksheet
    Dim xMWS As Worksheet
    Dim xNWS As Worksheet
    Dim xPWS As Worksheet
    Dim xQWS As Worksheet
    Dim xRWS As Worksheet
    Dim xSWS As Worksheet
    Dim xTWS As Worksheet
    Dim xUWS As Worksheet
    Dim xVWS As Worksheet
    Dim xWWS As Worksheet
    Dim xXWS As Worksheet
    Dim xYWS As Worksheet
    Dim xZWS As Worksheet

    Dim xAAR, xAR, xBR, xCR, xDR, xER, xFR, xGR, xHR, xIR, xJR, xKR, xLR, xMR, xNR, xPR, xQR, xRR, xSR, xTR, xUR, xVR, xWR, xXR, xYR, xZR As Long

    Dim xDC As Long
    Dim K As Long
    Dim xC1 As Long
    Dim xFNum As Long

    Set xAAWS = Worksheets("Sheet1") 'Ô?Ê ÇÕá?
    Set xAWS = Worksheets("Sheet2") 'åÒ??å ÈÓÊå ÈäÏ?
    Set xBWS = Worksheets("Sheet3") 'åÒ?äå ÊÈá?ÛÇÊ
    Set xCWS = Worksheets("Sheet4") 'åÒ?äå ÇÏÇÔ
    Set xWS = Worksheets("Sheet5") 'åÒ?äå ÛÑÝå ÞÕÇÈ?
    Set xEWS = Worksheets("Sheet6") 'åÒ?äå ÍÞæÞ
    Set xFWS = Worksheets("Sheet7") 'åÒ?äå ÏÑãÇä
    Set xGWS = Worksheets("Sheet8") 'åÒ?äå ÓÝÑæÝæÞ ÇáÚÇÏå ãÇãæÑ?Ê ÏÇÎá ˜ÔæÑ
    Set xHWS = Worksheets("Sheet9") 'åÒ?äå Ç?ÇÈ æÐåÇÈ
    Set xIWS = Worksheets("Sheet10") 'ÂÈÜÜÜÜÜÜÜÏÇÑÎÜÜÜÜÜÜÇäå
    Set xJWS = Worksheets("Sheet11") 'åÒíäå ÑÓäá æÙ?Ýå
    Set xKWS = Worksheets("Sheet12") 'ÊäÙíÜÜÜÜÜÝ æ ÈÜÜÇÛÈÜÜÜÇäÜÜÜÜÜí
    Set xLWS = Worksheets("Sheet13") 'åÒíäå ÌÔä æÐíÑÇí?
    Set xMWS = Worksheets("Sheet14") 'åÒíäå ÓÊ ÊáÝä
    Set xNWS = Worksheets("Sheet15") 'åÒíäå äæÔÊ ÇÝÒÇÑ
    Set xPWS = Worksheets("Sheet16") 'åÒíäå ÈÇä˜í
    Set xQWS = Worksheets("Sheet17") 'ÊÚãíÑ æ äåÏÇÑí ÇËÜÜÜÜÜÜÇËå
    Set xRWS = Worksheets("Sheet18") 'åÒ?äå ÊÚã?Ñ æäåÏÇÑí ÓÇÎÊãÇä
    Set xSWS = Worksheets("Sheet19") 'åÒ?äå ÊÚã?Ñ æäåÏÇÑí ÊÇÓ?ÓÇÊ
    Set xTWS = Worksheets("Sheet20") 'åÒ?äå ÊÚã?Ñ æÓÇÆØ äÞáíå
    Set xUWS = Worksheets("Sheet21") 'åÒ?äå ÊÌå?ÒÇÊ ÑÇ?Çäå
    Set xVWS = Worksheets("Sheet22") 'åÒ?äå ÓæÎÊ æÓÇÆØ äÞá?å
    Set xWWS = Worksheets("Sheet23") 'åÒ?äå Íãá æäÞá æÊÎá?å æÈÇѐ?Ñ?
    Set xXWS = Worksheets("Sheet24") 'ÓÇíÑ åÒíäå åÇ
    Set xYWS = Worksheets("Sheet25") 'åÒíäå ÍÞ ÕäÏÞÏÇÑ?
    Set xZWS = Worksheets("Sheet26") 'åÒíäå áÈÇÓ

    xAAR = xAAWS.UsedRange.Rows.Count
    xAR = xAWS.UsedRange.Rows.Count
    xBR = xBWS.UsedRange.Rows.Count
    xCR = xCWS.UsedRange.Rows.Count
    xDR = xWS.UsedRange.Rows.Count
    xER = xEWS.UsedRange.Rows.Count
    xFR = xFWS.UsedRange.Rows.Count
    xGR = xGWS.UsedRange.Rows.Count
    xHR = xHWS.UsedRange.Rows.Count
    xIR = xIWS.UsedRange.Rows.Count
    xJR = xJWS.UsedRange.Rows.Count
    xKR = xKWS.UsedRange.Rows.Count
    xLR = xLWS.UsedRange.Rows.Count
    xMR = xMWS.UsedRange.Rows.Count
    xNR = xNWS.UsedRange.Rows.Count
    xPR = xPWS.UsedRange.Rows.Count
    xQR = xQWS.UsedRange.Rows.Count
    xRR = xRWS.UsedRange.Rows.Count
    xSR = xSWS.UsedRange.Rows.Count
    xTR = xTWS.UsedRange.Rows.Count
    xUR = xUWS.UsedRange.Rows.Count
    xVR = xVWS.UsedRange.Rows.Count
    xWR = xWWS.UsedRange.Rows.Count
    xXR = xXWS.UsedRange.Rows.Count
    xYR = xYWS.UsedRange.Rows.Count
    xZR = xZWS.UsedRange.Rows.Count
    xDC = xAAWS.UsedRange.Columns.Count

    If xAR = 1 Then
    If Application.WorksheetFunction.CountA(xAWS.UsedRange) = 0 Then xAR = 0
    End If
    If xBR = 1 Then
    If Application.WorksheetFunction.CountA(xBWS.UsedRange) = 0 Then xBR = 0
    End If
    If xCR = 1 Then
    If Application.WorksheetFunction.CountA(xCWS.UsedRange) = 0 Then xCR = 0
    End If
    If xDR = 1 Then
    If Application.WorksheetFunction.CountA(xWS.UsedRange) = 0 Then xDR = 0
    End If
    If xER = 1 Then
    If Application.WorksheetFunction.CountA(xEWS.UsedRange) = 0 Then xER = 0
    End If
    If xFR = 1 Then
    If Application.WorksheetFunction.CountA(xFWS.UsedRange) = 0 Then xFR = 0
    End If
    If xGR = 1 Then
    If Application.WorksheetFunction.CountA(xGWS.UsedRange) = 0 Then xGR = 0
    End If
    If xHR = 1 Then
    If Application.WorksheetFunction.CountA(xHWS.UsedRange) = 0 Then xHR = 0
    End If
    If xIR = 1 Then
    If Application.WorksheetFunction.CountA(xIWS.UsedRange) = 0 Then xIR = 0
    End If
    If xJR = 1 Then
    If Application.WorksheetFunction.CountA(xJWS.UsedRange) = 0 Then xJR = 0
    End If
    If xKR = 1 Then
    If Application.WorksheetFunction.CountA(xKWS.UsedRange) = 0 Then xKR = 0
    End If
    If xLR = 1 Then
    If Application.WorksheetFunction.CountA(xLWS.UsedRange) = 0 Then xLR = 0
    End If
    If xMR = 1 Then
    If Application.WorksheetFunction.CountA(xMWS.UsedRange) = 0 Then xMR = 0
    End If
    If xNR = 1 Then
    If Application.WorksheetFunction.CountA(xNWS.UsedRange) = 0 Then xNR = 0
    End If
    If xPR = 1 Then
    If Application.WorksheetFunction.CountA(xPWS.UsedRange) = 0 Then xPR = 0
    End If
    If xQR = 1 Then
    If Application.WorksheetFunction.CountA(xQWS.UsedRange) = 0 Then xQR = 0
    End If
    If xRR = 1 Then
    If Application.WorksheetFunction.CountA(xRWS.UsedRange) = 0 Then xRR = 0
    End If
    If xSR = 1 Then
    If Application.WorksheetFunction.CountA(xSWS.UsedRange) = 0 Then xSR = 0
    End If
    If xTR = 1 Then
    If Application.WorksheetFunction.CountA(xTWS.UsedRange) = 0 Then xTR = 0
    End If
    If xUR = 1 Then
    If Application.WorksheetFunction.CountA(xUWS.UsedRange) = 0 Then xUR = 0
    End If
    If xVR = 1 Then
    If Application.WorksheetFunction.CountA(xVWS.UsedRange) = 0 Then xVR = 0
    End If
    If xWR = 1 Then
    If Application.WorksheetFunction.CountA(xWWS.UsedRange) = 0 Then xWR = 0
    End If
    If xXR = 1 Then
    If Application.WorksheetFunction.CountA(xXWS.UsedRange) = 0 Then xXR = 0
    End If
    If xYR = 1 Then
    If Application.WorksheetFunction.CountA(xYWS.UsedRange) = 0 Then xYR = 0
    End If
    If xZR = 1 Then
    If Application.WorksheetFunction.CountA(xZWS.UsedRange) = 0 Then xZR = 0
    End If

    Set xRg = xAAWS.Range("C1:C" & xAAR)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count

    If CStr(xRg(K).Value) = "packing" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xAWS.Range("A" & xAR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xAR = xAR + 1

    ElseIf CStr(xRg(K).Value) = " Advertising" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xBWS.Range("A" & xBR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xBR = xBR + 1

    ElseIf CStr(xRg(K).Value) = "reward" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xCWS.Range("A" & xCR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xCR = xCR + 1

    ElseIf CStr(xRg(K).Value) = " Butcher shop" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xWS.Range("A" & xDR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xDR = xDR + 1

    ElseIf CStr(xRg(K).Value) = " Rights" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xEWS.Range("A" & xER + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xER = xER + 1

    ElseIf CStr(xRg(K).Value) = " treatment" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xFWS.Range("A" & xFR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xFR = xFR + 1

    ElseIf CStr(xRg(K).Value) = " Travel and mission" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xGWS.Range("A" & xGR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xGR = xGR + 1

    ElseIf CStr(xRg(K).Value) = " Transportation" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xHWS.Range("A" & xHR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xHR = xHR + 1

    ElseIf CStr(xRg(K).Value) = " Juice House" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xIWS.Range("A" & xIR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xIR = xIR + 1

    ElseIf CStr(xRg(K).Value) = " Duty personnel" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xJWS.Range("A" & xJR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xJR = xJR + 1

    ElseIf CStr(xRg(K).Value) = " Cleaning and gardening" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xKWS.Range("A" & xKR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xKR = xKR + 1

    ElseIf CStr(xRg(K).Value) = " Celebration and reception" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xLWS.Range("A" & xLR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xLR = xLR + 1

    ElseIf CStr(xRg(K).Value) = " Phone" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xMWS.Range("A" & xMR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xMR = xMR + 1

    ElseIf CStr(xRg(K).Value) = " Stationery" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xNWS.Range("A" & xNR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xNR = xNR + 1

    ElseIf CStr(xRg(K).Value) = " Bank charges" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xPWS.Range("A" & xPR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xPR = xPR + 1

    ElseIf CStr(xRg(K).Value) = " Repair and maintenance of furniture" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xQWS.Range("A" & xQR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xQR = xQR + 1

    ElseIf CStr(xRg(K).Value) = " Building maintenance" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xRWS.Range("A" & xRR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xRR = xRR + 1

    ElseIf CStr(xRg(K).Value) = " Facility maintenance" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xSWS.Range("A" & xSR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xSR = xSR + 1

    ElseIf CStr(xRg(K).Value) = " Vehicle maintenance" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xTWS.Range("A" & xTR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xTR = xTR + 1

    ElseIf CStr(xRg(K).Value) = " Computer equipment " Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xUWS.Range("A" & xUR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xUR = xUR + 1

    ElseIf CStr(xRg(K).Value) = " Vehicle fuel" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xVWS.Range("A" & xVR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xVR = xVR + 1

    ElseIf CStr(xRg(K).Value) = " Transportation, unloading and loading" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xWWS.Range("A" & xWR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xWR = xWR + 1

    ElseIf CStr(xRg(K).Value) = " other costs" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xXWS.Range("A" & xXR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xXR = xXR + 1

    ElseIf CStr(xRg(K).Value) = " cash desk " Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xYWS.Range("A" & xYR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xYR = xYR + 1

    ElseIf CStr(xRg(K).Value) = "dress" Then
    Set xRRg1 = xRg(K).EntireRow
    Set xRRg2 = xZVWS.Range("A" & xZR + 1).EntireRow
    For xFNum = 1 To xDC
    xRRg2.Value = xRRg1.Value
    Next xFNum
    xRg(K).EntireRow.Delete
    xZR = xZR + 1

    End If
    Next K
    Application.ScreenUpdating = True
    End Sub
        
  • To post as a guest, your comment is unpublished.
    Masouddodangeh · 3 months ago
    Hello everyone
    How to create a bet inside sheet one
    For example, column E1, which has the same name as the different sheets, can be saved by writing each row in the tabs of the same name with that row.
    Thank You
  • To post as a guest, your comment is unpublished.
    Rafaella · 3 months ago
    Hello everyone,

    thank you for these codes, they are working perfectly in almost all situations. However, I'm having an issue with the copy and past one. It's not pasting on the next empty cell, but on the next non-active (never used) cell. I've tried to clear the content from the editing menu, but even after doing that, closing and opening the file, it keeps pasting only from the first cell that was never used before. Does anyone have any suggestion or a solution on what's happening?

    I would appreciate any help.
  • To post as a guest, your comment is unpublished.
    ldwilson · 5 months ago
    I'm doing somewhat of the same thing Miranda did below; however I have a drop down box on main sheet that designates a column (Column M) with 6 choices. I wanted to copy those rows to the designated sheet. Like this: If it says Complete - copy row to Sheet3; In Review - copy row to Sheet4; Not Yet Rec'd - copy row to Sheet5; Not Shell Complete - copy row to Sheet6; Partial - copy row to Sheet7; Send Request - copy row to Sheet8). I also want to remove it from one sheet except master sheet (Sheet1) to another each time the designation changes. Once it reaches "Complete" the designation stops there.
  • To post as a guest, your comment is unpublished.
    Callum · 5 months ago
    I have got this to work on a spreadsheet I am working on, but is there a way to have it automatically move over rows, but only copy not delete. Each row has a unique reference in column A which could help.

    When I tried it either copies the entries it has already moved over or crash from continuously copying the rows over.

     
  • To post as a guest, your comment is unpublished.
    Lucy Hughes · 5 months ago
    Hiya

    Thanks for this - it's to helpful. I wondered if I could ask - would this VBA code be impacted, when using columns which are using formula?

    For example, when using the VBA code 2: Copy entire row to another sheet based on cell value I am wanting to copy rows from one sheet to another, based on whether column J has a "Y" entered. This "Y" is entered into the cells in column J, using the IF formula. When I run the VBA, it copies over the row accurately, however parts of the row it transfers, are not transferred correctly i.e. column A of the row is correct but column B is the information from 5 rows below. 

    I hope I'm making some kind of sense!

     I wonder if sending you the spreadsheet would help?

    Thanks

    Lucy Hughes
  • To post as a guest, your comment is unpublished.
    smartfox25 · 6 months ago
    How can I modify the VBA to clear the contents/delete cells just from the columns in the original sheet that I specify, rather than the entire row? I specified just which columns to pull from on the copy side, but in the next line if I do anything other than Entirerow delete it doesn't work.
  • To post as a guest, your comment is unpublished.
    jdlerry · 6 months ago
    This is very helpful, although I need more help please. When I used the instructions in "Move Entire Row To Another Sheet Based On Cell Value With VBA Code", it worked except that:
    1. Not automatic. I have to go to the Module and click F5 for the code to run and move it to Completed cases. Any way this should be automatic, like when I click the dropdown, it should move right away.
  • To post as a guest, your comment is unpublished.
    Matthew · 6 months ago
    Hello, This is extremely helpful, and I have been able to get it to work in a few examples. But in the case of it not deleting the value in the first sheet, is there a way for it to not copy the same info into Sheet2 each time I run the macro?
    • To post as a guest, your comment is unpublished.
      crystal · 6 months ago
      Hi Matthew,
      There are two codes in the post. The VBA code 1 is for moving rows, and the VBA code 2 is for copying rows. If you want to move rows and delete the values in the original sheet, please apply the VBA code 1.
  • To post as a guest, your comment is unpublished.
    burkitis · 7 months ago
    Hey all! I LOVE the example where the items are valued as "done", but I have a similar situation, where I don't have "done", but a completion date instead, and I'm looking to have items that have been completed for 30 days (random number) to be relocated to an archive sheet. Any tips on how that might go? Thanks!
  • To post as a guest, your comment is unpublished.
    Kieran Rao · 7 months ago

    I have used the VBA code1 which works great. It moves the row which contains a specific text as it should from sheet1 to sheet2. How do I enable it to additionally move a row from sheet2 to sheet3 when required also. I naively tried to put this code into a different module with the sheet names changed but this just brings back a debug error.

    • To post as a guest, your comment is unpublished.
      crystal · 7 months ago
      Hi Kieran Rao,
      Your operation is correct. Just insert a new Module, copy the code into it and change the sheet names and value(if the value change).
      What kind of error did you get?

  • To post as a guest, your comment is unpublished.
    Miranda · 7 months ago
    Hey! I copied the code from Liam W and Edwin, but I want it so that when I update the drop down status/data on the Master Sheet and change it from LIVE to ENDED, it removes itself from the LIVE Sheet and is now on the ENDED sheet, but all stays on the Master sheet. Is that possible?

    Additionally, if I add new content on the Master Sheet, is there a way for it to autorun, loop, etc. and send the updates to LIVE and/or ENDED? Or do you have to keep running the Macro anytime there is a new information on the Master Sheet?
    • To post as a guest, your comment is unpublished.
      crystal · 7 months ago
      Hi Miranda,
      The code works well in my case. After running the code, the entire row will be moved to the specified worksheet.
      Please don't forget to change the "C1:C" in the line "" to the column that contains the values you will move entire row based on.
      View Code
      Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Updated by Extendoffice 20210319 Dim xRg As Range Dim xCell As Range Dim xRRg1 As Range Dim xRRg2 As Range Dim xDWS As Worksheet Dim xLWS As Worksheet Dim xEWS As Worksheet Dim xDR, xLR, xER As Long Dim xDC As Long Dim K As Long Dim xC1 As Long Dim xFNum As Long Set xDWS = Worksheets("Sheet1") Set xLWS = Worksheets("Sheet2") 'LIVE Set xEWS = Worksheets("Sheet3") 'ENDED xDR = xDWS.UsedRange.Rows.Count xLR = xLWS.UsedRange.Rows.Count xER = xEWS.UsedRange.Rows.Count xDC = xDWS.UsedRange.Columns.Count If xLR = 1 Then If Application.WorksheetFunction.CountA(xLWS.UsedRange) = 0 Then xLR = 0 End If If xER = 1 Then If Application.WorksheetFunction.CountA(xEWS.UsedRange) = 0 Then xER = 0 End If Set xRg = xDWS.Range("C1:C" & xDR) On Error Resume Next Application.ScreenUpdating = False For K = 1 To xRg.Count If CStr(xRg(K).Value) = "LIVE" Then Set xRRg1 = xRg(K).EntireRow Set xRRg2 = xLWS.Range("A" & xLR + 1).EntireRow For xFNum = 1 To xDC xRRg2.Value = xRRg1.Value Next xFNum xRg(K).EntireRow.Delete xLR = xLR + 1 ElseIf CStr(xRg(K).Value) = "ENDED" Then Set xRRg1 = xRg(K).EntireRow Set xRRg2 = xEWS.Range("A" & xER + 1).EntireRow For xFNum = 1 To xDC xRRg2.Value = xRRg1.Value Next xFNum xRg(K).EntireRow.Delete xER = xER + 1 End If Next K Application.ScreenUpdating = True End Sub
      • To post as a guest, your comment is unpublished.
        Miranda Avdalen · 7 months ago
        Thanks for that. For some reason, my ENDED page keeps starting on line 13. I changed the code slightly so that it doesn't delete but copies the row over from the main worksheet to the ENDED worksheet, but it keeps starting on line 13. Any chance you know why that might be, and/or what do to to fix it?

        Thanks!
  • To post as a guest, your comment is unpublished.
    L.M. · 7 months ago
    I wanted to move the row when certain cells are filled, regardless of what text they are as long as they are have value. In my case if columns G to L have values, this marks that all steps have been completed and I want to move it to the other worksheet automatically, without having to press F5 or manually click run. Is this possible?
  • To post as a guest, your comment is unpublished.
    Edwin · 8 months ago
    Hello, Thank you for this wonderful Macro. May I ask, what if I would also like to move "No" on another sheet?
    • To post as a guest, your comment is unpublished.
      crystal · 8 months ago
      Hi Edwin,
      This question had been asked by LiamW 2 years ago: I have column "M" which has "LIVE" & "ENDED", I have used your code to work so that "LIVE" goes to "Sheet2" but how do I add more code so that "ENDED" is copied to "Sheet3"?
      Please try the below VBA and change the values and worksheets based on your needs.
      Sub MoveRowBasedOnCellValue() Dim xRg As Range Dim xCell As Range Dim xRRg1 As Range Dim xRRg2 As Range Dim xDWS As Worksheet Dim xLWS As Worksheet Dim xEWS As Worksheet Dim xDR, xLR, xER As Long Dim xDC As Long Dim K As Long Dim xC1 As Long Dim xFNum As Long Set xDWS = Worksheets("Sheet1") Set xLWS = Worksheets("Sheet2") 'LIVE Set xEWS = Worksheets("Sheet3") 'ENDED xDR = xDWS.UsedRange.Rows.count xLR = xLWS.UsedRange.Rows.count xER = xEWS.UsedRange.Rows.count xDC = xDWS.UsedRange.Columns.count If xLR = 1 Then If Application.WorksheetFunction.CountA(xLWS.UsedRange) = 0 Then xLR = 0 End If If xER = 1 Then If Application.WorksheetFunction.CountA(xEWS.UsedRange) = 0 Then xER = 0 End If Set xRg = xDWS.Range("C1:C" & xDR) On Error Resume Next Application.ScreenUpdating = False For K = 1 To xRg.count If CStr(xRg(K).Value) = "LIVE" Then Set xRRg1 = xRg(K).EntireRow Set xRRg2 = xLWS.Range("A" & xLR + 1).EntireRow For xFNum = 1 To xDC xRRg2.Value = xRRg1.Value Next xFNum xRg(K).EntireRow.Delete xLR = xLR + 1 ElseIf CStr(xRg(K).Value) = "ENDED" Then Set xRRg1 = xRg(K).EntireRow Set xRRg2 = xEWS.Range("A" & xER + 1).EntireRow For xFNum = 1 To xDC xRRg2.Value = xRRg1.Value Next xFNum xRg(K).EntireRow.Delete xER = xER + 1 End If Next K Application.ScreenUpdating = True End Sub
  • To post as a guest, your comment is unpublished.
    tressa_anne · 8 months ago
    I've gotten my code to work successfully when transferring to another worksheet, however it is pasting over the existing information within that workbook instead of adding to the next available row.. I have tried to modify, but I am extremely green when it comes to VBA codes.

    Sub MoveResolvedDelinquency()
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("January 2021").UsedRange.Rows.Count
    J = Worksheets("Resolved Delinquency").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Resolved Delinquency").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("January 2021").Range("I1:I" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
    If CStr(xRg(K).Value) = "Current" Then
    xRg(K).EntireRow.Copy Destination:=Worksheets("Resolved Delinquency").Range("A" & LrowCompleted + 1)
    xRg(K).EntireRow.Delete
    If CStr(xRg(K).Value) = "Current" Then
    K = K - 1
    End If
    J = J + 1
    End If
    Next
    Application.ScreenUpdating = True
    End Sub
    • To post as a guest, your comment is unpublished.
      crystal · 8 months ago
      Hi,
      The copied values won't overwrite the existing information in the destination worksheet. Which Excel version are you using?
      • To post as a guest, your comment is unpublished.
        tressa_anne · 8 months ago
        Hi Crystal -
        think it's because I have to run it for it to move, so it's just overriding the entries that are already made?
  • To post as a guest, your comment is unpublished.
    Siobahn · 10 months ago
    I have seen several people ask about copying the data without duplicating it, and I have yet to find where this was answered. Does anyone have the answer to this question? Thank you!
  • To post as a guest, your comment is unpublished.
    Jordan P · 10 months ago
    I keep getting a Run-Time error '9' subscript out of range, and then when I hit debug, it highlights this line:

    I = Worksheets("Sheet1").UsedRange.Rows.Count - I have replaced Sheet1 with the title of the sheet, Current Clients

    Any help would be greatly appreciated!

    • To post as a guest, your comment is unpublished.
      crystal · 10 months ago
      Hi,
      As the VBA code shown in the post, there are two "Sheet1" in the code. You need to replace both of them with the title of the sheet.
      If you only replace one of them, this kind of error will pop up.
  • To post as a guest, your comment is unpublished.
    Graham · 10 months ago
    Can the VBA Code 2 be used in such a way as to overwrite the existing previous data in Sheet 2 so that if sheet 1 is modified the new application of the macro will overwrite the old Sheet2. Also can this line be modified to be a reference to a cell "If CStr(xRg(K).Value) = "Done" Then" so that you can type in what you want to move, other than "Done", and the macro uses it. For example I may want to move data based on "Tax" and then on "Price" later.

    Thank you for these helpful instructions.
    • To post as a guest, your comment is unpublished.
      Kimberly · 3 months ago
      I need this too.:)
  • To post as a guest, your comment is unpublished.
    Frank · 1 years ago
    Hello. First and foremost, thank you for you continued efforts and hard work. This site is great. I am attempting to slightly modify the "move" script but am running into issues as my VB skills are not strong. One of the comments below is similar to what i'm trying to accomplish but different enough to still give me trouble. I'll try to explain as best as I can. I have two sheets. Master and Shipment. Master is a sheet of on hand inventory. Shipment is a temp sheet where a barcode scanner downloads unique serial numbers that also exist on the Master sheet (Column O on Master, Column A on Shipment). What I would like to do is after downloading the barcodes, execute the macro and if/when it matches, copy the matching row (Column A thru E) from Shipment and paste it to the matching row on Master (Beginning with Column Q thru U). Crystal helped another user about 2 years ago with something similar where the user was trying to match on a dynamic value rather than "Done". If you search this page for "CStr(yRg(M).Value)", you will find the post. I was able to use some of this to copy the data from Shipment to a new Sheet, but not able to copy it to my desired sheet nor the proper cell location. I currently have this working with a different approach but I feel the approach I am currently using is inefficient and takes quite a while. I'll paste the code below as it might help you understand better what I am attempting. Thank you in advance and for all your efforts in helping us in need.

    Frank

    My current macro:
    Private Sub CommandButton1_Click()

    Application.Interactive = False

    Dim Cl As Range
    Dim Dic As Object

    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Shipment")
    For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    Dic.Item(Cl.Value) = Cl.Offset(, 1).Resize(, 5)
    Next Cl
    End With
    With Sheets("Master")
    For Each Cl In .Range("O2", .Range("O" & Rows.Count).End(xlUp))
    If IsEmpty(Cl.Offset(, 2).Value) Then
    Cl.Offset(, 2).Resize(, 5) = Dic.Item(Cl.Value)
    End If
    Next Cl
    End With

    Sheets("Shipment").Range("A2:A100").ClearContents

    Sheet4.Activate

    Application.Interactive = True

    End Sub
  • To post as a guest, your comment is unpublished.
    Lynn · 1 years ago
    I am using the first VBA code. Essentially I have a column that I change to completed then I run the macros and this information moves to the completed page. It was working perfectly however it is not anymore. Eventually when i would run the macros the "completed"data started showing up extremely far down in the worksheet.I will note that the information on both worksheets is in a table. I figured out how to clear out the table and run the macros and have it show up right under the last moved data. BUT then it was not in the table! If I resize the table to include the data the next time I run the macros this new data goes directly under the table... so if I choose my table to end at row 500 my new data starts in row 501. I need to be able to move my data from one worksheet to another, have it stay in the table and not have large gaps in between the data(blank rows).. I hope this makes sense
    • To post as a guest, your comment is unpublished.
      Jason · 3 months ago
      Lynn, I am having the same issue now. Have you by chance found a resolution yet? 
  • To post as a guest, your comment is unpublished.
    Marissa · 1 years ago
    Is there a way to modify the code so that is doesn't duplicate already copied data?
  • To post as a guest, your comment is unpublished.
    R. Matkin · 1 years ago
    This is very useful script. Thank you very much. However, I need to move the line in sheet 1 to sheet 2 only if 2 different cell's criteria are met such as cell b and cell h both contain the world YES. Is this possible?
  • To post as a guest, your comment is unpublished.
    Jeremy · 1 years ago
    Hi, thanks for everything! My code is pasting my rows at the bottom of my table... help please.


    Private Sub CommandButton1_Click()
    'Updated by Extendoffice 2017/11/10
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim M As Long
    Dim K As Long
    I = Worksheets("June").UsedRange.Rows.Count
    M = Worksheets("July").UsedRange.Rows.Count
    If M = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("July").UsedRange) = 0 Then M = 0
    End If
    Set xRg = Worksheets("June").Range("J3:J" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
    If CStr(xRg(K).Value) = "Part or Material On Order" Then
    xRg(K).EntireRow.Copy Destination:=Worksheets("July").Range("A" & M + 1)
    M = M + 1
    End If
    Next
    Application.ScreenUpdating = True
    End Sub
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi Jeremy,
      This tutorial is talking about how to move a row to the bottom based on cell value. Maybe you can find the answer from it. Thank you!
      https://www.extendoffice.com/documents/excel/3725-excel-move-row-to-bottom.html
  • To post as a guest, your comment is unpublished.
    stusurrey · 1 years ago
    This is a really useuful resource and the code Crystal posted about automatically moving a row to another sheet based on a selection works perfectly. The problem I have is that I am moving rows from one Row (based on the selection of 'Yes' in Column O). To another sheet. But both source and destination sheets are tables. This code works bu places teh row to the next free row outside of the table not inside it? Can you help? Thx.
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi stusurrey,
      Try the below VBA code. Hope I can help. Thank you.

      Sub MoveRowBasedOnCellValue()
      'Updated by Kutools for Excel 2020/5/22
      Dim xRg As Range
      Dim xCell, xCell1, xCell2 As Range
      Dim xWs1, xWs2 As Worksheet
      Dim I As Long
      Dim J As Long
      Dim K As Long
      Dim xp, xNum1, xNum2 As Long
      Dim xLO As ListObject
      Set xWs1 = Worksheets("Sheet1")
      Set xWs2 = Worksheets("Sheet2")
      I = xWs1.UsedRange.Rows.Count
      Set xLO = xWs2.ListObjects.Item(1)
      Set xCell = xLO.Range
      Set xCell1 = xCell.Item(1)
      Set xCell2 = xCell.Item(xCell.Count)
      J = xLO.Range.Rows.Count + xLO.Range.Item(1).Row - 1
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
      End If
      Set xRg = Worksheets("Sheet1").Range("O1:O" & I)
      On Error Resume Next
      Application.ScreenUpdating = False
      xp = 1
      For K = 1 To xRg.Count
      If CStr(xRg(K).Value) = "Yes" Then
      xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      J = J + 1
      xRg(K).EntireRow.Delete
      If CStr(xRg(K).Value) = "Yes" Then
      K = K - 1
      End If
      xp = xp + 1
      End If
      Next
      Set xCell2 = xWs2.Cells(xCell2.Row + xp - 1, xCell2.Column) 'xCell2.Offset(xp, 0)
      Debug.Print xCell2.Address
      xLO.Resize Range(xCell1.Address & ":" & xCell2.Address)
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    Brent · 1 years ago
    Crystal,

    Is there a way to modify the code so that is does not duplicate already copied data?
  • To post as a guest, your comment is unpublished.
    Lyn · 1 years ago
    Good Day,

    this code works and thanks a lot but i have 1 concern, when i delete some of the data in sheet 2, let say i deleted the info at the middle of sheet 2 then the info of that deleted part will be blank. when i run the program again it will only jump to the bottom part of the row. do you know how to use the offset? so that it will replace the blank part instead of pasting the data to the last row. thank in advance
  • To post as a guest, your comment is unpublished.
    Christina · 1 years ago
    Morning - I have a spreadsheet where if Yes is selected in column S in multiple sheets "January, February, March and so forth..." It will move the row details A-T to a separate sheet called Reversals automatically instead of hitting F5. All sheets including the Reversals sheet has the same header on row 1. Please assist with the VBA code. I have tried gathering different solutions based on the scenarios posted and I can't seem to get it to work seamlessly. Appreciate any guidance!
  • To post as a guest, your comment is unpublished.
    Said · 1 years ago
    Is it possible to paste values only without formatting?

    Thanks.
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi Said,
      Please try the below VBA. Hope I can help.

      Sub MoveRowBasedOnCellValue()
      'Updated by Extendoffice 2020/05/19
      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.Copy
      Worksheets("Sheet2").Range("A" & J + 1).PasteSpecial Paste:=xlPasteValues
      J = J + 1
      End If
      Next
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    migzllanderw891@gmail.com · 1 years ago
    Hi Crystal!!
    Thanks for sharing this amazing code.
    I have a request
    can you change the copy paste to copy paste value, i have formulas on excel that will not be needed anymore once copied to another sheet. Thanks much
  • To post as a guest, your comment is unpublished.
    Erica · 2 years ago
    Does this not work if Column C is a drop down?
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi Erica,
      The code works for drop-down list option as well.
  • To post as a guest, your comment is unpublished.
    Mike · 2 years ago
    Kutools looks like a handy feature however, I don't know if it would work for what I'm trying to do.
    I'm trying to use advanced INDEX and MATCH functions to pull entire rows out of one sheet and move to another automatically. For instance, if I were to have 3 sheets open, let's say I copy data from an Internet database, put it in Excel format, copy it to Sheet 2. Once I do that, I have Sheet 1 automatically pulling a limited amount of data from Sheet 2 to automatically populate Sheet 1 already using the INDEX and MATCH functions. That part I have down using this function: INDEX(Sheet2!A:Q,ROW()-2,(MATCH("TicketFromSiteLeaseCompanyName",Sheet2!$A$1:$Q$1,0))). This particular formula I don't completely understand what each piece is, but pulls data from Sheet 2 under the column title "TicketFromSiteLeaseCompanyName" to Sheet 1 at that particular cell where this formula goes.
    What I'm trying to do is once Sheet 1 is done, use the INDEX and MATCH functions for Sheet 3 to take entire rows from Sheet 1 that the common factor would be an employees name and all the data that goes with it to Sheet 3. To get more specific, Sheet 3 would be renamed an employee's name and what I would like to do is set up a formula that would automatically populate Sheet 3 with just that employees information from Sheet 1 as the information is put into Sheet 1. By the way, there would be many many sheets after 3, each one having a different employees' name. I'm just using 3 sheets here total as a simple example.
    I was also thinking of using a pivot table but I would have to build it every time and that's what I'm trying to avoid. I want to make a template one time then all I'd have to do is populate Sheet 2 and every other sheet in the database should take care of itself.

    Any and all information on this would be extremely helpful Thank You.
  • To post as a guest, your comment is unpublished.
    Tyler · 2 years ago
    Hello - I love this code! Thanks so much. One thing I was wondering is how you could manipulate the code to pull in more than one piece of date. For ex. if the selected column contained "Done" and "Pending". I've tried a few different codes and couldn't get it.

    Any help would be greatly appreciated!

    Thanks again! :)
  • To post as a guest, your comment is unpublished.
    Rose · 2 years ago
    Hi, Thank you for your post! Currently, I have adapted your code to shift a row from one sheet to the other. Right now, I'm writing another module so that I can shift the row back to the original row position (in case where the cell value entry was entered wrongly). Would it be possible to allocate it back specifically to the row where it shifted from?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Rose,
      You can reverse the sheet names in the code to shift the row back to the original worksheet, but the row can't be allocated back to th original row position.
      Sorry for that.
      Thank you for your comment.
  • To post as a guest, your comment is unpublished.
    natleon08 · 2 years ago
    Hi

    I tried to read all of the comments but was unable to find the solution to my issue.
    I have 5 transaction codes (IPL, ISL, CAPO, IIC, IMO) in cell DC
    If cell DC = "ISL" or "IIC" or "IMO" then copy that row but only columns DE:FN to a new sheet in a new workbook
    If cell DC = "IPL" then copy that row but only columns DE:FN to a new sheet in another new workbook
    If cell DC = "CAPO" then copy that row but only columns DE:FN to a new sheet in another new workbook

    I want each new workbook sorted by the 14th column in the extracted range & saved in a specified location with the macro ending after the newly created workbooks have been closed.
  • To post as a guest, your comment is unpublished.
    Isaiah · 2 years ago
    Is there a way to prevent data from being duplicated when copied? I want to use this as sort of a long term log and the sheet I am entering data into is the weekly variant. I am copying my entries to a longterm yearly version. Currently this script produces duplicates each time an entry is made. I need to prevent these duplicates.
  • To post as a guest, your comment is unpublished.
    Stephen · 2 years ago
    Is there a way I could insert the row into the top row of a table on the second page?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Stephen,
      Sorry can't help you with that.
      • To post as a guest, your comment is unpublished.
        Ioan Parry-Jones · 1 months ago
        hi there, has anyone figured out this problem?
  • To post as a guest, your comment is unpublished.
    Susu · 2 years ago
    Hi, how can I copy entire line based on values in row K and must be more then 0, I tried but...
    Thanks crystal :)
  • To post as a guest, your comment is unpublished.
    Harry · 2 years ago
    Hi, This thread has been really helpful. I was just wondering how I would modify the below code to only copy cells A & B for each "Done" row instead or the entire row.

    e.g. for row 6, C6 = "Done". How would i copy only cells A6 & B6 across to the next sheet instead of the entire row



    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


    Thank you in advance
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Harry,
      Try this VBA code. Hope I can help.

      Sub Cheezy()
      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 'Data
      End If
      Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.Count
      Debug.Print CStr(xRg(K).Value)
      If InStr(1, CStr(xRg(K).Value), "Done") > 0 Then
      Range("A" & xRg(K).Row & ":" & "B" & xRg(K).Row).Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      xRg(K).EntireRow.Delete
      K = K - 1
      J = J + 1
      End If
      Next
      Application.ScreenUpdating = True
      End Sub

      Sub EnableEvents()
      Application.EnableEvents = True
      End Sub
  • To post as a guest, your comment is unpublished.
    Jackson · 2 years ago
    I am using your code, however I encounter an error with line 8 (below) when I run the macro

    I = Worksheets("Sheet1").UsedRange.Rows.Count

    I'm at a loss as to why this may be occurring, would this macro be affected by there being several drop down lists in the row? or by applied conditional formatting?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Jackson,
      The macro doesn't be affected by drop-down lists as well as conditional formatting.
      Have you change the sheet name in this line to your actually used sheet name?
  • To post as a guest, your comment is unpublished.
    mouzzampk2014 · 2 years ago
    Hi, could you please help me out how can I use this with activex control button e.g. when I press the button then data move to sheet2? Thank you so much
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Hassan Arshad,
      Right click the activex control button and select View Code from the context menu, then copy the below code between the Private Sub and the End Sub lines.

      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
  • To post as a guest, your comment is unpublished.
    Bradley · 2 years ago
    How do I make the VBA code run automatically? When the cell I am targeting changes to the value, it is not deleting and moving. I have to open the dialog and run it.
    • To post as a guest, your comment is unpublished.
      Laurie Black · 2 years ago
      Make sure to add Developer tab first

      On the Developer tab, in the Code group, click Macros.
      In the Macro name box, click the macro you want to run and press the Run button.

      You will also have the choice to add a shortkey from here
  • To post as a guest, your comment is unpublished.
    Aprodoehl · 2 years ago
    This is a HUGE help, thank you! Is there a way to move rows if values are less than a given value?
  • To post as a guest, your comment is unpublished.
    AnneD · 2 years ago
    Hello, thank you so much for this post. Instead of only "Done" I have several words to find, it can be around 100. I have them all in Column A of Sheet 2. I need to find those words from Sheet 1 and paste the entire row(s) in sheet 3, if the words match. How can I do that? I would really appreciate your help.
  • To post as a guest, your comment is unpublished.
    Anju · 2 years ago
    Hi, I have a sheet where are liscence renewal details are present, when the due date is nearing (before 2 months) those liscence details need to sent as an email to a single recipient. I have used today formula and calculated the days remaining from the due date. So I am using that cell- if the value is above 60, it must copy the entire cell and put it into another workbook. It has to repeat this until it reaches the end. could you help me writing a code on this ?
  • To post as a guest, your comment is unpublished.
    Anne · 2 years ago
    Hello, thank you so much for this code. How To Move Entire Row To Another Sheet Based On a column? Let's say in sheet 2, I have Case IDs in column A. And I need to find anything associated with those Case IDs in Sheet 1 and paste it in Sheet 3. Can you please help me do that?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Anne,
      Sorry can't help you with that. Thank you for your comment.
  • To post as a guest, your comment is unpublished.
    TJ · 2 years ago
    Thanks, this helped me alot. I am not an Excel expert! I used the the module in VBA you created to transfer rows from Sheet 1 to Sheet 2. My project is that I'm moving objects to designated locations that were set up in a certain order in another column located in Sheet 1. When I run the module, I lose the location because the rows shift up in Sheet 1 after the transfer. I have to insert a row and type in the designated location again. Can it be set up so that I can at least keep the blank row and just type in the location needed?
  • To post as a guest, your comment is unpublished.
    SB · 2 years ago
    Thank you! If it is not too much trouble could you please post how to have the destination data overwrite vs. append to the last line? Specifically to overwrite data starting at A2. Thank you!
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Good Day,
      For moving data and overwrite data starting at A2 in the destination worksheet, please apply the below code.

      Sub MoveRowOverwrite()
      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 = 1
      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
      J = J + 1
      End If
      Next
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    Charlene · 2 years ago
    I have a drop down list to code which person transfers to which sheet. But I can only get one person to transfer with your code. Help? :)
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Charlene,
      The following VBA code can help you solve the problem. Please change the "PERSON1" and "PERSON2" to the person as you need. In this case, the row of PERSON1 will be moved to Sheet2, and the row of PERSON2 will be moved to Sheet3.

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      Dim xRg As Range
      Dim xCell As Range
      Dim xRRg1 As Range
      Dim xRRg2 As Range
      Dim xDWS As Worksheet
      Dim xLWS As Worksheet
      Dim xEWS As Worksheet
      Dim xDR, xLR, xER As Long
      Dim xDC As Long
      Dim K As Long
      Dim xC1 As Long
      Dim xFNum As Long
      Set xDWS = Worksheets("Sheet1")
      Set xLWS = Worksheets("Sheet2") 'LIVE
      Set xEWS = Worksheets("Sheet3") 'ENDED
      xDR = xDWS.UsedRange.Rows.Count
      xLR = xLWS.UsedRange.Rows.Count
      xER = xEWS.UsedRange.Rows.Count
      xDC = xDWS.UsedRange.Columns.Count
      If xLR = 1 Then
      If Application.WorksheetFunction.CountA(xLWS.UsedRange) = 0 Then xLR = 0
      End If
      If xER = 1 Then
      If Application.WorksheetFunction.CountA(xEWS.UsedRange) = 0 Then xER = 0
      End If
      Set xRg = xDWS.Range("C1:C" & xDR)
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.Count
      If CStr(xRg(K).Value) = "PERSON1" Then
      Set xRRg1 = xRg(K).EntireRow
      Set xRRg2 = xLWS.Range("A" & xLR + 1).EntireRow
      For xFNum = 1 To xDC
      xRRg2.Value = xRRg1.Value
      Next xFNum
      xRg(K).EntireRow.Delete
      xLR = xLR + 1
      ElseIf CStr(xRg(K).Value) = "PERSON2" Then
      Set xRRg1 = xRg(K).EntireRow
      Set xRRg2 = xEWS.Range("A" & xER + 1).EntireRow
      For xFNum = 1 To xDC
      xRRg2.Value = xRRg1.Value
      Next xFNum
      xRg(K).EntireRow.Delete
      xER = xER + 1
      End If
      Next K
      Application.ScreenUpdating = True
      End Sub