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

or

Sut i symud rhes gyfan i ddalen arall yn seiliedig ar werth celloedd yn Excel?

Ar gyfer symud rhes gyfan i ddalen arall yn seiliedig ar werth celloedd, bydd yr erthygl hon yn eich helpu chi.

Symud rhes gyfan i ddalen arall yn seiliedig ar werth celloedd gyda chod VBA
Symud rhes gyfan i ddalen arall yn seiliedig ar werth celloedd gyda Kutools ar gyfer Excel


Symud rhes gyfan i ddalen arall yn seiliedig ar werth celloedd gyda chod VBA

Fel isod y llun a ddangosir, mae angen i chi symud y rhes gyfan o Sheet1 i Sheet2 os oes gair penodol “Wedi'i wneud” yn bodoli yng ngholofn C. Gallwch roi cynnig ar y cod VBA canlynol.

1. Gwasgwch Alt+ F11 allweddi ar yr un pryd i agor y Microsoft Visual Basic ar gyfer Ceisiadau ffenestr.

2. Yn ffenestr Microsoft Visual Basic for Applications, cliciwch Mewnosod > Modiwlau. Yna copïwch a gludwch y cod VBA isod i'r ffenestr.

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

Nodyn: Yn y cod, Sheet1 ydy'r daflen waith yn cynnwys y rhes rydych chi am ei symud. Ac Sheet2 yw'r daflen waith cyrchfan lle byddwch chi'n dod o hyd i'r rhes. “C: C.”Yw'r golofn yn cynnwys y gwerth penodol, a'r gair“Wedi'i wneud”Yw'r gwerth penodol y byddwch chi'n symud rhes yn seiliedig arno. Newidiwch nhw ar sail eich anghenion.

3. Gwasgwch y F5 allwedd i redeg y cod, yna bydd y rhes sy'n cwrdd â'r meini prawf yn Nhaflen 1 yn cael ei symud i Sheet2 ar unwaith.

Nodyn: Bydd y cod VBA uchod yn dileu rhesi o'r data gwreiddiol ar ôl symud i daflen waith benodol. Os mai dim ond rhesi yn seiliedig ar werth celloedd yr ydych am eu copïo yn lle eu dileu. Defnyddiwch y cod VBA 2 isod.

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

Symud rhes gyfan i ddalen arall yn seiliedig ar werth celloedd gyda Kutools ar gyfer Excel

Os ydych chi'n newbie yng nghod VBA. Dyma fi'n cyflwyno'r Dewiswch Gelloedd Penodol cyfleustodau Kutools ar gyfer Excel. Gyda'r cyfleustodau hwn, gallwch chi ddewis pob rhes yn hawdd yn seiliedig ar werth celloedd penodol neu werthoedd celloedd gwahanol mewn taflen waith, a chopïo'r rhesi a ddewiswyd i'r daflen waith cyrchfan yn ôl yr angen. Gwnewch fel a ganlyn.

Cyn gwneud cais Kutools ar gyfer Excel, os gwelwch yn dda ei lawrlwytho a'i osod yn gyntaf.

1. Dewiswch y rhestr golofnau sy'n cynnwys y gwerth cell y byddwch chi'n symud rhesi yn seiliedig arno, yna cliciwch Kutools > dewiswch > Dewiswch Gelloedd Penodol. Gweler y screenshot:

2. Yn yr agoriad Dewiswch Gelloedd Penodol blwch deialog, dewiswch Rhes gyfan yn y Math o ddewis adran, dewiswch Equals yn y Math penodol rhestr ostwng, rhowch werth y gell yn y blwch testun ac yna cliciwch ar y OK botwm.

Arall Dewiswch Gelloedd Penodol blwch deialog yn ymddangos i ddangos i chi nifer y rhesi a ddewiswyd, ac yn y cyfamser, mae pob rhes sy'n cynnwys y gwerth penodedig yn y golofn a ddewiswyd wedi'u dewis. Gweler y screenshot:

3. Gwasgwch y Ctrl + C allweddi i gopïo'r rhesi a ddewiswyd, ac yna eu pastio i'r daflen waith cyrchfan sydd ei hangen arnoch.

Nodyn: Os ydych chi am symud rhesi i daflen waith arall yn seiliedig ar ddau werth cell gwahanol. Er enghraifft, symud rhesi yn seiliedig ar werthoedd celloedd naill ai "Wedi'i wneud" neu "Prosesu", gallwch chi alluogi'r Or cyflwr yn y Dewiswch Gelloedd Penodol blwch deialog fel isod dangosir y llun:

  Os ydych chi am gael treial am ddim (30 diwrnod) o'r cyfleustodau hwn, cliciwch i'w lawrlwytho, ac yna ewch i gymhwyso'r llawdriniaeth yn ôl y camau uchod.


Erthyglau perthnasol:


Yr Offer Cynhyrchedd Swyddfa Gorau

Mae Kutools for Excel yn Datrys y rhan fwyaf o'ch Problemau, ac yn Cynyddu Eich Cynhyrchedd 80%

  • Ailddefnyddio: Mewnosod yn gyflym fformwlâu cymhleth, siartiau ac unrhyw beth rydych chi wedi'i ddefnyddio o'r blaen; Amgryptio Celloedd gyda chyfrinair; Creu Rhestr Bostio ac anfon e-byst ...
  • Bar Fformiwla Gwych (golygu llinellau lluosog o destun a fformiwla yn hawdd); Cynllun Darllen (darllen a golygu nifer fawr o gelloedd yn hawdd); Gludo i'r Ystod Hidlo...
  • Uno Celloedd / Rhesi / Colofnau heb golli Data; Cynnwys Celloedd Hollt; Cyfuno Rhesi / Colofnau Dyblyg... Atal Celloedd Dyblyg; Cymharwch y Meysydd...
  • Dewiswch Dyblyg neu Unigryw Rhesi; Dewiswch Blank Rows (mae pob cell yn wag); Darganfyddiad Gwych a Darganfyddiad Niwlog mewn Llawer o Lyfrau Gwaith; Dewis ar Hap ...
  • Copi Union Celloedd Lluosog heb newid cyfeirnod fformiwla; Auto Creu Cyfeiriadau i Daflenni Lluosog; Mewnosod Bwledi, Blychau Gwirio a mwy ...
  • Testun Detholiad, Ychwanegu Testun, Tynnu yn ôl Swydd, Tynnwch y Gofod; Creu ac Argraffu Subtotals Paging; Trosi rhwng Cynnwys a Sylwadau Celloedd...
  • Hidlo Super (arbed a chymhwyso cynlluniau hidlo i ddalenni eraill); Trefnu Uwch yn ôl mis / wythnos / dydd, amlder a mwy; Hidlo Arbennig gan feiddgar, italig ...
  • Cyfuno Llyfrau Gwaith a Thaflenni Gwaith; Uno Tablau yn seiliedig ar golofnau allweddol; Rhannwch Ddata yn Daflenni Lluosog; Trosi Swp xls, xlsx a PDF...
  • Mwy na 300 o nodweddion pwerus. Yn cefnogi Swyddfa / Excel 2007-2019 a 365. Yn cefnogi pob iaith. Defnydd hawdd yn eich menter neu sefydliad. Nodweddion llawn treial am ddim 30 diwrnod. Gwarant arian yn ôl 60 diwrnod.
tab kte 201905

Mae Tab Office yn Dod â rhyngwyneb Tabbed i'r Swyddfa, a Gwneud Eich Gwaith yn Haws o lawer

  • Galluogi golygu a darllen tabbed yn Word, Excel, PowerPoint, Cyhoeddwr, Mynediad, Visio a Phrosiect.
  • Agor a chreu dogfennau lluosog mewn tabiau newydd o'r un ffenestr, yn hytrach nag mewn ffenestri newydd.
  • Yn cynyddu eich cynhyrchiant 50%, ac yn lleihau cannoedd o gliciau llygoden i chi bob dydd!
gwaelod officetab
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.
    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 · 3 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 · 3 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
  • To post as a guest, your comment is unpublished.
    cvmccogg · 3 years ago
    I am using the formula to move rows to a second tab and delete the row from the first tab...it is deleting the row in the first tab, but not moving the row to the second. I'm wondering if it is because I have not give the correct qualifier to "A" in row 18 of the formula?? What is the "A" for?
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Hi Carol,
      The "A" in row 18 means that the qualified row will be moved to the first column in the given sheet.
  • To post as a guest, your comment is unpublished.
    Carol · 3 years ago
    I'm trying to use the formula to move rows to another tab while deleting the row in the original tab. The formula deletes from the original tab, but does not move the information. I'm wondering if it is because I have not given a qualifier for the "A" in line 18 of the module. What is that for?
  • To post as a guest, your comment is unpublished.
    olsen · 3 years ago
    This is AMAZING! how would I modify to capture 2 criteria?? Ex: Cell in main workbook column C = 'Done'...and column A shows either 'Tom', 'Dick', or 'Harry'. I have a tabs in the workbook for Tom, Dick, and Harry.... so if row had Done and Tom, it would be appended to the end of the spreadsheet on the Tom tab.
  • To post as a guest, your comment is unpublished.
    pawJ · 3 years ago
    works more or less. It copy's the right ine, but does not copy it to the first line in the given sheet. It leaves a number of empty lines at first
  • To post as a guest, your comment is unpublished.
    robertmayer25@gmail.com · 3 years ago
    Hello Crystal,


    I am using VBA 1 and it is working great. I added the automatic code to my sheet to automate the process and when i put in the trigger word it deletes that line and all of the lines below it, wiping out my entire table.


    Do you have any suggestions?


    Thank you,
    Robert
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Hi Robert Mayer,
      Your automatic code should be as follows.

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      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
      Please have a try. If problem still exists, please let me know and tell me your Excel version.
      Thanks you for your comment.
  • To post as a guest, your comment is unpublished.
    Scott · 3 years ago
    How can move the selected row and paste it as a "Value". My selection has formulas, so when it is moved I get a lot of ref errors since it's still tied to the original formula.
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Hi Scott,
      The below VBA code can solve the problem, please have a try. Thank you for your comment.

      Sub Cheezy01()
      Dim xRg As Range
      Dim xCell As Range
      Dim xRRg1 As Range
      Dim xRRg2 As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      Dim xC1 As Long
      Dim xFNum As Long
      Dim xDShName As String
      Dim xRShName As String
      xDShName = "Sheet1"
      xRShName = "Sheet2"
      I = Worksheets(xDShName).UsedRange.Rows.count
      J = Worksheets(xRShName).UsedRange.Rows.count
      xC1 = Worksheets(xDShName).UsedRange.Columns.count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets(xRShName).UsedRange) = 0 Then J = 0
      End If
      Set xRg = Worksheets(xDShName).Range("C1:C" & I)
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.count
      If CStr(xRg(K).Value) = "Done" Then
      Set xRRg1 = xRg(K).EntireRow
      Set xRRg2 = Worksheets(xRShName).Range("A" & J + 1).EntireRow

      xRRg2.Value = xRRg1.Value

      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
  • To post as a guest, your comment is unpublished.
    LiamW · 3 years ago
    Hi, This works great and is very helpful but can you explain how I would do the following?

    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"?

    Thank you
    • To post as a guest, your comment is unpublished.
      Anne · 2 years ago
      Good question, what about if I have several of those "LIVE" "ENDED" "DONE" "GONE" "SUNDAY" etc... It can be up to 89, they are listed in a column.
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Hi Liam,
      Please try the following VBA code. Hope it can help and thank you for your comment.

      Sub Cheezy()
      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.
    R3 · 3 years ago
    Hi, I get a syntax error on the line:

    Set xRg = Worksheets("Maternity Sub-Committee ACCC").Range("B:B" & I)

    Can you please help me? Thanks
    • To post as a guest, your comment is unpublished.
      Guest · 3 years ago
      For your range, it needs to be "B1:B". That will make it work!
  • To post as a guest, your comment is unpublished.
    AV · 3 years ago
    I used this code previously without problems, but now I can't get it to work quite right (I have no VB coding experience, so probably a silly mistake). Everything works except the row I want doesn't get copied to the final destination of Sheet2 - nothing appears there. Original row deleted just fine from Sheet1. I do have a header row in Sheet2 - could that be a problem?
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Good day,
      The problem you mentioned does not appear in my case. Do you mind uploading your workbook for me to check?
      Thanks for your comment.
  • To post as a guest, your comment is unpublished.
    dcompany814@gmail.com · 3 years ago
    Not working for me !!!!! please help!!!!



    I am getting syntax error on first line Sub Cheezy()
    What changes I need to do to fix this.
    I made changes as mentioned in description.
  • To post as a guest, your comment is unpublished.
    Ramesh · 3 years ago
    It is not working for me please help!!!!!!



    its giving me an syntax error at first line Sub Cheezy().


    I copped code as it is and changed values mentioned in description.
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Hi Ramesh,
      May I know your Office verson? I need the feedback to check for the error. Thanks for your comment.
  • To post as a guest, your comment is unpublished.
    Ryan · 3 years ago
    I'm trying to move cells with a VLOOKUP function and when I use the code below, it pastes the formula, but it moves the cell values down as it pastes the formula down the rows. For example... the row that I'm copying is looking up $A1:$B27. When it pastes on the next sheet using the Macro it pastes $A2:$B29 then $A3:$B30 and so on and so forth. Is there a fix for this either in my VBA code or in my VLOOKUP formula?
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Hi Ryan,
      Didn't find your code here.
      Welcome to post any question in our forum: https://www.extendoffice.com/forum.html to get more Excel support from out Excel professional or other Excel fans.
      Thanks for your comment.
  • To post as a guest, your comment is unpublished.
    gowtham · 3 years ago
    Hi,

    If i add the data in sheet1 it is not moving automatically,how to copy the data to another sheets
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Hi gowtham,
      If you want to automatically move the row after entering the data, please try the below VBA code.

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      On Error Resume Next
      Application.ScreenUpdating = False
      If Target.Count = 1 And Intersect(Target, Columns(3)) Then
      I = ActiveSheet.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
      If Target.Value = "Done" Then
      Target.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      Target.EntireRow.Delete
      End If
      End If
      Application.ScreenUpdating = True
      End Sub
      • To post as a guest, your comment is unpublished.
        Steph · 3 years ago
        Do you add this in place of Sub Cheezy()'s VBA, or in addition to? If so, where do you place it? (VBA newbie here)
        • To post as a guest, your comment is unpublished.
          Marta Andino · 10 months ago
          Is there is a way to see the answer provided to Steph on her question above?
          • To post as a guest, your comment is unpublished.
            crystal · 10 months ago
            See the below screenshot:
          • To post as a guest, your comment is unpublished.
            crystal · 10 months ago
            Hi,
            The code needs to be added in a new code window.
            In the worksheet that contains the value you will move row based on, right click the sheet name tab, click View Code from the context menu. In the opening sheet code window, copy the code into it, click the Save button to save the code and then press the Alt + Q keys to close the code window.
      • To post as a guest, your comment is unpublished.
        kimpoy1209 · 3 years ago
        Hello Crystal,

        Good day! I have been following your posts and I really appreciate all the tips and tricks you've been giving to everyone.
        Is it possible to help me please on my current challenge? I have been working on a file where I need to check if the value on the cell is found on a range from another sheet, then move it to another sheet.

        Here's my scenario

        Sheet1, range B2:B100 contains the range of values that serve as masterdata/list

        Sheet2, column C is what should be checked - if value is found on sheet1 range B2:B100

        Sheet3: If Sheet 2 Column C data is found, then entire row is moved to Sheet3.

        I have been using your early reference www.extendoffice.com/documents/excel/372....html?page_comment=1

        but it is only for a single criteria.



        Thank you in advance!
        • To post as a guest, your comment is unpublished.
          crystal · 3 years ago
          Hi Kim,
          The below VBA code can help you solve the problem. Thanks for your comment.

          Sub Cheezy()
          'Updated by Kutools for Excel 2018/8/6

          Dim xRg As Range
          Dim yRg As Range
          Dim I As Long
          Dim K As Long
          Dim J As Long

          I = Worksheets("Sheet1").UsedRange.Rows.Count
          J = Worksheets("Sheet3").UsedRange.Rows.Count
          secRow = Worksheets("Sheet2").UsedRange.Rows.Count
          If J = 1 Then
          If Application.WorksheetFunction.CountA(Worksheets("Sheet3").UsedRange) = 0 Then J = 0
          End If

          Set xRg = Worksheets("Sheet1").Range("B2:B100")
          'Set xRg = Worksheets("Sheet1").Range("A1:C" & I)
          Set yRg = Worksheets("Sheet2").Range("C1:C" & secRow)

          On Error Resume Next
          Application.ScreenUpdating = False
          Dim M As Long
          Dim N As Long

          For N = 1 To xRg.Count
          For M = 1 To yRg.Count
          If CStr(xRg(N).Value) = CStr(yRg(M).Value) Then
          yRg(M).EntireRow.Copy Destination:=Worksheets("Sheet3").Range("A" & J + 1)
          yRg(M).EntireRow.Delete
          If CStr(xRg(N).Value) = CStr(yRg(M).Value) Then
          N = N - 1
          End If
          J = J + 1
          End If
          Next

          Next

          Application.ScreenUpdating = True
          End Sub
          • To post as a guest, your comment is unpublished.
            kimpoy1209 · 3 years ago
            Hi Crystal, Thank you! This worked for me.

            Going back to the original codes to move rows to another worksheet. It's been working for me for sometime.

            Now I have this issue where, whenever I start to trigger the macro, the cut cells are not moved to the next blank rows.

            E.g. I have A1:Z1 as my headers, the data starts to fill rows A33 onwards.

            Have you encountered this before?


            One thing I did though is that I have copied the macro into different buttons, and tailor fit depending on what sheet I need to paste. Does that impact the original sheet? or any sheets? Thank you.
  • To post as a guest, your comment is unpublished.
    kassidy · 3 years ago
    This vba works perfectly for what I need to do, except I want the values pasted into Sheet 2 in a specific range. So, if sheet 1 data meets my criteria, it needs to populate into a formatted table on sheet 2. This table allows my data to be pasted from C6:H39. Is there anyway to change the code so that the data isn't pasted into the next available row on sheet 2?
  • To post as a guest, your comment is unpublished.
    Veer · 3 years ago
    Hi,
    Thanks for the the code above...its every helpful.
    I wanted one more help...can we have a code which will create a new row (entire row) in sheet 2 as it is doing now but only specific column data is pasted...

    Eg. Sheet 1 has say 7 columns - Client Name, Product, Address,Qty, Amount, Date, Order Status
    In sheet 2 i want only 4 columns- Client Name,Product, Amount, Date

    Now in sheet2 these 4 columns will populate from sheet 1 and rest columns relating to order processing will be entered by user.

    Thank in advance...
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Good day,
      Can't help with this. Thanks for your comment.
  • To post as a guest, your comment is unpublished.
    Jessica · 3 years ago
    The code for copying to a new sheet worked as expected. The issue I'm having is that I need to pull data from 3 sheets into a 4th sheet.

    How can I alter this to include data from "Sheet 1", "Sheet 2", and "Sheet 3" and copy it to "Sheet 4"?
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Hi Jessica,
      Thanks for your comment. Please try the below VBA code to solve your problem.

      Sub CopyRowBasedOnCellValueInWorksheets()
      Dim xWSArray As Variant
      Dim xWs, xDWs As Worksheet
      Dim xRg As Range
      Dim xCell As Range
      Dim xFNum As Integer
      Dim xDStr As String
      Dim I As Long
      Dim J As Long
      Dim K As Long

      WSArray = Array("Sheet1", "Sheet2", "Sheet3")
      xDStr = "Sheet4"
      On Error Resume Next
      Set xDWs = Worksheets(xDStr)
      J = xDWs.UsedRange.Rows.count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(xDWs.UsedRange) = 0 Then J = 0
      End If
      Application.ScreenUpdating = False
      For xFNum = LBound(WSArray) To UBound(WSArray)
      On Error GoTo Error1
      Set xWs = Worksheets(WSArray(xFNum))
      I = xWs.UsedRange.Rows.count
      Set xRg = xWs.Range("C1:C" & I)
      For K = 1 To xRg.count
      If CStr(xRg(K).Value) = "Done" Then
      xRg(K).EntireRow.Copy Destination:=xDWs.Range("A" & J + 1)
      J = J + 1
      End If
      Next
      Error1:
      Next xFNum
      Application.ScreenUpdating = True

      End Sub
  • To post as a guest, your comment is unpublished.
    Akfred · 3 years ago
    I was also trying to figure out how to move items in columns A - E while deleting the whole row, but when it copies to the last row in the second sheet, it only checks for inputs in columns A - E. So if I have a drop-down menu in column F, it still copies to that row.
  • To post as a guest, your comment is unpublished.
    Akfred · 3 years ago
    Hi Crystal,

    I was wondering if there was a way to copy just the text in the row? Not the color or fill.
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Good day,
      If you just want to move the text in the row, please try the following VBA code.

      Sub MoveRowBasedonCellValue()
      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
      Worksheets("Sheet2").Range("A" & J + 1).PasteSpecial xlPasteValues
      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
      • To post as a guest, your comment is unpublished.
        sam · 3 years ago
        I need to do this too but nothave my original data be deleted???
  • To post as a guest, your comment is unpublished.
    Bre · 3 years ago
    I have used this in my macro for quite a few months now but I just recently ran into an issue and I am trying to figure out how to get it to properly work again. I have it wrote to move anything that says "Paper" in column T to the Paper Tab but in the recent report I got all of the items ended up being labeled "Paper". So when I manually step through it it will move them properly but then it just keeps going. It doesn't even stop looping through. When I just run the macro by itself it is freezing the Excel document and never finishing. When i manually add something random in column T at the end of the spreadsheet the macro runs just fine. Any help without me having to add something random to be added in if all cells contain the same thing??
  • To post as a guest, your comment is unpublished.
    Gwen · 3 years ago
    Do you have any suggestions for how to make the code work so that it moves a row to the new sheet if there are numbers in the target column, but not if the column reads Pending? I can get it to work in a mockup spreadsheet but not the one I need to change. Thanks!
  • To post as a guest, your comment is unpublished.
    Janelle · 3 years ago
    Hi there,

    I think this is what I am looking for, but I have 4 values I need it to split between sheets how would I do that? For instant, if column L contains a "1" it copies columns a:d to sheet 2, if column L contains "2" it copies columns a:d to sheet 3 and so on. Is this possible?
  • To post as a guest, your comment is unpublished.
    chris · 3 years ago
    Hi,

    i need something to copy and delete rows where column L says "closed" and move the row to another tab/sheet called "closed orders". i tried the script above and it didnt work for my sheet but it did work when i did a test sheet with just 3 coumns.
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Dear chris,
      The code works well in my case. Have you replaced C1:C in the code with L1:L to meet your needs?
  • To post as a guest, your comment is unpublished.
    Ben · 3 years ago
    What if I didn't want to copy the entire row, but a limited amount of columns of that row?
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Hi Ben,
      Please try the below VBA code. The code can help you copy cells A - J from current worksheet "Sheet1" to another one "Data", and delete the ENTIRE row from the "Sheet1" once it has been copied over to the "Data" sheet. Hope it can help. Thank you.

      Private Sub Worksheet_Change(ByVal Target As Range)
      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("Data").UsedRange.Rows.Count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Data").UsedRange) = 0 Then J = 0 'Data
      End If
      Set xRg = Worksheets("Sheet1").Range("K1:K" & 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), "Complete") > 0 Then
      Range("A" & xRg(K).Row & ":" & "J" & xRg(K).Row).Copy Destination:=Worksheets("Data").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.
    bethrob1993 · 3 years ago
    Hi,

    I am using the macro that copies rows of data to another sheet. How might I get the macro to check multiple sheets - sheet 1, 2, 3 and so on, for the same information ("Done" in column G), and bring all relevant rows, across the sheets, to one sheet called "Reporting"?
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Hi Beth,
      Please try the below VA code. Hope it can help. Thank you.

      Sub MoveRowsToSheet()
      Dim xSh As Worksheet
      Dim xRg As Range
      Dim I, J, K As Long
      On Error Resume Next
      If Worksheets("Reporting") Is Nothing Then Exit Sub
      J = Worksheets("Reporting").UsedRange.Rows.Count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Reporting").UsedRange) = 0 Then J = 0
      End If
      I = xRgUsed(xRgUsed.Count).Row
      For Each xSh In Worksheets
      If xSh.Name <> "Reporting" Then
      Set xRg = xSh.UsedRange
      I = xRg(xRg.Count).Row
      Set xRg = Intersect(xRg, Range("G1:G" & I))
      If xRg Is Nothing Then GoTo Ctn
      Application.ScreenUpdating = False
      For K = 1 To xRg.Count
      If CStr(xRg(K).Value) = "Done" Then
      xRg(K).EntireRow.Copy Destination:=Worksheets("Reporting").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

      End If
      Ctn:
      Next
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    bethrob1993 · 3 years ago
    Hi Crystal,

    The code has worked really well. How do I get the code to move a row of data, but only the data between columns A and J?

    I have another table at the side of these rows that I don't want it to move.

    Thanks
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Hi Beth,
      Please try the below VBA code. Hope it can help. Thank you.

      Private Sub Worksheet_Change(ByVal Target As Range)
      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("Data").UsedRange.Rows.Count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Data").UsedRange) = 0 Then J = 0 'Data
      End If
      Set xRg = Worksheets("Sheet1").Range("K1:K" & 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), "Complete") > 0 Then
      Range("A" & xRg(K).Row & ":" & "J" & xRg(K).Row).Copy Destination:=Worksheets("Data").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.
    Hector · 3 years ago
    Hi Crystal,


    How do i Modify your code to add another layer to it. so say that if a cell has either "Done" or "Finished" in it, it should move the row. how do i add that modification?
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Dear Hector,
      The below VBA code can help you solve the problem, please have a try. Thank you.

      Sub MoveRowBasedOnCellValue()
      'Updated by Extendoffice 2018/5/22
      Dim xRg As Range
      Dim xCell As Range
      Dim xStr As String
      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
      xStr = CStr(xRg(K).Value)
      If xStr = "Done" Or xStr = "Finished" Then
      xRg(K).EntireRow.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
  • To post as a guest, your comment is unpublished.
    Brandon · 3 years ago
    I am using the code that moves the Row to another Tab and deletes the line. I am able to edit the code to work for my purpose, however I have a dropdown that contains 3 choices. Call them One, Two, and Three. If left blank, do nothing and leave the row alone. If dropdown choice One is selected, I am able to get that data moved to tab 1. I just need the additional code added to move Two to 2 and Three to 3. Please Help.
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Dear Brandon,
      The following VBA code can help you to solve the problem. Please put the code into the worksheet (the sheet that contains the drop-down list) code window.

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim I As Long
      Dim xStr As String
      Application.EnableEvents = False
      If Target.Column = 3 And _
      Target.Validation.Type = 3 And _
      Target.CountLarge = 1 Then
      xStr = Target.Value
      xStr = IIf(xStr = "One", "1", IIf(xStr = "Two", "2", IIf(xStr = "Three", "3", "")))
      I = Worksheets(xStr).UsedRange.Rows.Count
      If I = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets(xStr).UsedRange) = 0 Then I = 0
      End If
      Rows(Target.Row).Copy Destination:=Worksheets(xStr).Range("A" & I + 1)
      Rows(Target.Row).Delete
      End If
      Application.EnableEvents = True
      End Sub

      If the above code doesn't work, please run the below code to enable the event. Hope it can help. Thank you.

      Sub EnableEvents()
      Application.EnableEvents = True
      End Sub
      • To post as a guest, your comment is unpublished.
        Brandon · 3 years ago
        Thanks so much for the reply but I had to remove this functionality. It started going wacky and pulling over data that wasn't supposed to be pulled. Thinking it might not like the conditional formatting I have programmed to change the cell color based on the selection, but I honestly don't know. The fact it's automatic concerns me in the sense I may click the incorrect value in the drop-down. I'd feel much better adding a buttons to do the exact same functionality as I requested above. Not sure how much of an undertaking that would be, but let me know if it's feasible.
  • To post as a guest, your comment is unpublished.
    Casandra · 3 years ago
    Can this same code be used to move the contents when a checkbox is checked instead of typing the word done?
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Dear Casandra,
      Supposing there are Check Boxes(ActiveX Control) in column C of your worksheet, and rows will be moved to Sheet6 when check box is checked. Please apply the below VBA code in your worksheet's code window. Hope it can help. Thank you.

      Function MoveRowBasedOnCheckBox()
      'Updated by Kutools for Excel 2018/5/21
      Cheezy = Worksheets("Sheet6").UsedRange.Rows.Count
      If Cheezy = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Sheet6").UsedRange) = 0 Then Cheezy = 0
      End If
      End Function
      Private Sub CheckBox1_Click()
      Dim I As Long
      Dim xRow As Long
      Dim xRg As Range
      On Error Resume Next
      If Me.CheckBox1 = True Then
      Set xRg = Me.CheckBox1.TopLeftCell
      If xRg.Column = 3 Then
      xRow = Me.CheckBox1.TopLeftCell.Row
      I = Cheezy
      Rows(xRow).Copy Destination:=Worksheets("Sheet6").Range("A" & I + 1)
      Rows(xRow).Delete
      OLEObjects("CheckBox1").Delete
      Call Add(Worksheets("Sheet6"), I + 1)
      End If
      End If
      End Sub
      Private Sub CheckBox2_Click()
      Dim I As Long
      Dim xRow As Long
      Dim xRg As Range
      On Error Resume Next
      If Me.CheckBox2 = True Then
      Set xRg = Me.CheckBox1.TopLeftCell
      If xRg.Column = 3 Then
      xRow = Me.CheckBox2.TopLeftCell.Row
      I = Cheezy
      Rows(xRow).Copy Destination:=Worksheets("Sheet6").Range("A" & I + 1)
      Rows(xRow).Delete
      OLEObjects("CheckBox2").Delete
      Call Add(Worksheets("Sheet6"), I + 1)
      End If
      End If
      End Sub
      'Copy above CheckBox code for other CheckBoxes
      Sub Add(xSheet As Worksheet, ByRef I As Long)
      Dim xRg As Range
      Set xRg = xSheet.Cells(I, 3)
      xSheet.OLEObjects.Add ClassType:="Forms.CheckBox.1", _
      Link:=False, DisplayAsIcon:=False, Left:=xRg.Left, Top:=xRg.Top, _
      Width:=xRg.Width, Height:=xRg.Height
      End Sub
  • To post as a guest, your comment is unpublished.
    julia · 3 years ago
    This is wonderful! Thank you!!

    I'm currently using the following VBA (I'm also new to this). 1-I want it to update automatically without manually having to press F5. 2- I ONLY want to copy cells A - J from the "Production Board" to the "Data" Sheet. 3- I want to delete the ENTIRE row from the "Production Board" once it has been copied over to the "Data" sheet

    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("Production Board").UsedRange.Rows.Count
    J = Worksheets("Data").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Data").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Production Board").Range("K1:K" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
    If CStr(xRg(K).Value) = "Complete" Then
    xRg(K).EntireRow.Copy Destination:=Worksheets("Data").Range("A" & J + 1)
    xRg(K).EntireRow.Delete
    If CStr(xRg(K).Value) = "Complete" 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 · 3 years ago
      Dear Julia,
      Please try the following VBA code. Hope it can help. Thank you.

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      I = Worksheets("Production Board").UsedRange.Rows.Count 'Production Board
      J = Worksheets("Data").UsedRange.Rows.Count 'Data
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Data").UsedRange) = 0 Then J = 0 'Data
      End If
      Set xRg = Worksheets("Production Board").Range("K1:K" & I) 'Production Board
      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), "Complete") > 0 Then
      Range("A" & xRg(K).Row & ":" & "J" & xRg(K).Row).Copy Destination:=Worksheets("Data").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.
        Kimberly · 3 years ago
        Hi Crystal,

        Is it possible to do this but with nonspecific sheet names? I tried to set the following but it didn't work. Thank you!
        Private Sub Worksheet_Change(ByVal Target As Range)
        Dim xRg As Range
        Dim xCell As Range
        Dim I As Long
        Dim J As Long
        Dim K As Long
        Dim sName As String
        Dim s2Name As String
        sName = Sheets(2).Name
        s2Name = Sheets(3).Name
        I = Worksheets("sName").UsedRange.Rows.Count 'sName
        J = Worksheets("s2Name").UsedRange.Rows.Count 's2Name
        If J = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("s2Name").UsedRange) = 0 Then J = 0 's2Name
        End If
        Set xRg = Worksheets("sName").Range("D1:D" & I) 'sName
        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), "Proposal") > 0 Then
        Range("A" & xRg(K).Row & ":" & "J" & xRg(K).Row).Copy Destination:=Worksheets("s2Name").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.
    Wendy0128 · 3 years ago
    This is fantastic but how can I combine them (from how similar they it appears it can be done, I just can't get it spliced in right to make it work)? What I am trying to do is when the word is "Sold" it moves the row but when the word is "Partial" it copies the row (words are both in the same column). Thanks for your help.
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Dear Wendy,
      Supposing rows will be moved or copied from Sheet1 to Sheet2 based on specified values, the following VBA code can help you solve the problem. Thank you for your comment.

      Sub MoveRowBasedOnCellValue()
      'Updated by Extendoffice 2018/05/21
      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("E1:E" & I)
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.Count
      If CStr(xRg(K).Value) = "Sold" Then
      xRg(K).EntireRow.Cut Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      xRg(K).EntireRow.Delete
      K = K - 1
      J = J + 1
      ElseIf CStr(xRg(K).Value) = "Partial" Then
      xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      J = J + 1
      End If
      Next
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    Shane · 3 years ago
    I can't get it to work. At all. Nothing happens. The screen flashes once real quick like something did happen, but when I go to the tab the lines were supposed to be copied to, it's still blank. Here are the differences between what I have and your example:
    1. First 2 rows are freeze-paned.
    2. I need all this to start on row for on source sheet, and row 4 on destination sheet - They both have the first 2 rows freeze-paned (for titles).
    I need it copied and not moved, so I used your second example, and made my modifications.

    Here is what I'm using:

    Sub WEST()
    '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("Mar 18 CIA").UsedRange.Rows.Count
    J = Worksheets("West").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("West").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Mar 18 CIA").Range("E4:E" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
    If CStr(xRg(K).Value) = "West" Then
    xRg(K).EntireRow.Copy Destination:=Worksheets("West").Range("A" & J + 1)
    J = J + 1
    End If
    Next
    Application.ScreenUpdating = True
    End Sub
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Good day,
      Your code works well. Please check if case sensitive exist between cells in column E and the specified word "West". Thank you.
  • To post as a guest, your comment is unpublished.
    abrah336@d.umn.edu · 3 years ago
    Thanks Crystal, this code was working great for me last week but it seems to be giving me issues this week. I have multiple items that update to a "completed" status when I open the workbook and all of these items should be moving but instead the code seems to error out.... I just get the blue spinning circle and excel eventually stops responding. Is there something I need to do to the code so that it can handle multiple rows at the same time?


    Sub Complete()
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("New-Open EFR'S").UsedRange.Rows.Count
    J = Worksheets("Completed EFR's").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Completed EFR's").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("New-Open EFR'S").Range("O1:O" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
    If CStr(xRg(K).Value) = "Complete" Then
    xRg(K).EntireRow.Copy Destination:=Worksheets("Completed EFR's").Range("A" & J + 1)
    xRg(K).EntireRow.Delete
    If CStr(xRg(K).Value) = "Complete" 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 · 3 years ago
      Good Day,
      Please change the first line in the code to "Private Sub Worksheet_Change(ByVal Target As Range)", and change "Complete" to "Completed". See code below:

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      I = Worksheets("New-Open EFR'S").UsedRange.Rows.Count
      J = Worksheets("Completed EFR's").UsedRange.Rows.Count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Completed EFR's").UsedRange) = 0 Then J = 0
      End If
      Set xRg = Worksheets("New-Open EFR'S").Range("O1:O" & I)
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.Count
      If CStr(xRg(K).Value) = "Completed" Then
      xRg(K).EntireRow.Copy Destination:=Worksheets("Completed EFR's").Range("A" & J + 1)
      xRg(K).EntireRow.Delete
      If CStr(xRg(K).Value) = "Complete" 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.
        Cynthia · 9 months ago
        Hi Crystal,

        Your suggestions have been really helpful. My VBA code below works perfectly when copying rows between sheets in the same workbook.
        Please advise on how to copy across workbooks based on cell value input. Thanks

        Sub CopyRowBasedOnCellValue2()

        Dim xRg As Range
        Dim xCell As Range
        Dim A As Long
        Dim B As Long
        Dim C As Long
        Dim D As Long
        Dim E As Long
        Dim F As Long
        Dim G As Long
        Dim H As Long
        Dim I As Long
        Dim J As Long
        Dim K As Long
        Dim L As Long


        A = Worksheets("Aggregator Onboarding").UsedRange.Rows.Count
        B = Worksheets("Nkechi (Corporate Affairs)").UsedRange.Rows.Count
        C = Worksheets("Cynthia (Process Officer)").UsedRange.Rows.Count
        D = Worksheets("Adeola (Corporate Strategist)").UsedRange.Rows.Count
        E = Worksheets("Ife (Legal & Compliance)").UsedRange.Rows.Count
        F = Worksheets("John (Operations and R&D)").UsedRange.Rows.Count
        G = Worksheets("Cordelia (Registration Desk)").UsedRange.Rows.Count


        If B = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("Nkechi (Corporate Affairs)").UsedRange) = 0 Then B = 0
        End If

        Set xRg = Worksheets("Aggregator Onboarding").Range("D2:D" & A)
        On Error Resume Next
        Application.ScreenUpdating = False

        For D = 1 To xRg.Count
        If CStr(xRg(D).Value) = "Nkechi" Then
        xRg(D).EntireRow.Copy Destination:=Worksheets("Nkechi (Corporate Affairs)").Range("A" & B + 2)
        B = B + 1
        End If
        Next
        Application.ScreenUpdating = True


        If C = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("Cynthia (Process Officer)").UsedRange) = 0 Then C = 0
        End If

        Set xRg = Worksheets("Aggregator Onboarding").Range("D2:D" & A)
        On Error Resume Next
        Application.ScreenUpdating = False

        For D = 1 To xRg.Count
        If CStr(xRg(D).Value) = "Cynthia" Then
        xRg(D).EntireRow.Copy Destination:=Worksheets("Cynthia (Process Officer)").Range("A" & C + 2)
        C = C + 1
        End If
        Next
        Application.ScreenUpdating = True

        If D = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("Adeola (Corporate Strategist)").UsedRange) = 0 Then D = 0
        End If

        Set xRg = Worksheets("Aggregator Onboarding").Range("D2:D" & A)
        On Error Resume Next
        Application.ScreenUpdating = False

        For D = 1 To xRg.Count
        If CStr(xRg(D).Value) = "Adeola" Then
        xRg(D).EntireRow.Copy Destination:=Worksheets("Adeola (Corporate Strategist)").Range("A" & D + 2)
        D = D + 1
        End If
        Next
        Application.ScreenUpdating = True

        If E = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("Ife (Legal & Compliance)").UsedRange) = 0 Then E = 0
        End If

        Set xRg = Worksheets("Aggregator Onboarding").Range("D2:D" & A)
        On Error Resume Next
        Application.ScreenUpdating = False

        For D = 1 To xRg.Count
        If CStr(xRg(D).Value) = "Ife" Then
        xRg(D).EntireRow.Copy Destination:=Worksheets("Ife (Legal & Compliance)").Range("A" & E + 2)
        E = E + 1
        End If
        Next
        Application.ScreenUpdating = True


        If F = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("John (Operations and R&D)").UsedRange) = 0 Then F = 0
        End If

        Set xRg = Worksheets("Aggregator Onboarding").Range("D2:D" & A)
        On Error Resume Next
        Application.ScreenUpdating = False

        For D = 1 To xRg.Count
        If CStr(xRg(D).Value) = "John" Then
        xRg(D).EntireRow.Copy Destination:=Worksheets("John (Operations and R&D)").Range("A" & F + 2)
        F = F + 1
        End If
        Next
        Application.ScreenUpdating = True


        If G = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("Cordelia (Registration Desk)").UsedRange) = 0 Then G = 0
        End If

        Set xRg = Worksheets("Aggregator Onboarding").Range("D2:D" & A)
        On Error Resume Next
        Application.ScreenUpdating = False

        For D = 1 To xRg.Count
        If CStr(xRg(D).Value) = "Cordelia" Then
        xRg(D).EntireRow.Copy Destination:=Worksheets("Cordelia (Registration Desk)").Range("A" & G + 2)
        G = G + 1
        End If
        Next
        Application.ScreenUpdating = True
        End Sub

  • To post as a guest, your comment is unpublished.
    SabinaM · 3 years ago
    Hi Crystal,

    Thank you very much for all your help with my spreadsheet.

    Could you please advice if i should remove conditional formatting from the spreadsheet to make the automated VBA code work and do not freeze the entire file.

    Thank you,

    Sabina
  • To post as a guest, your comment is unpublished.
    renaissancehero@gmail.com · 3 years ago
    Hi There,

    Thank you for such a great post and your very helpful counsel to everyone...
    How can I have the copied rows from Sheet1 always write on the 2nd row of Sheet2 over writing all the previous copies. Also, is there a way to have the search look for contents. Like Completed March 10th, 2018 by Eric. Search "*Completed*" . As of right now, the code has to be an exact match and I would like it to be search just one word.

    Will that work?
    Thank you for your time and your response in advance.

    Regards,
    HERO
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Good Day,
      The below VBA code can help you solve the problem.

      Sub MoveRowBasedOnCellValue()
      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 InStr(CStr(xRg(K).Value), "Completed") > 0 Then
      xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      J = J + 1
      End If
      Next
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    ashleybv67@gmail.com · 3 years ago
    Hello,


    I continue to get "Compile error: Syntax error on this


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





    What am I doing wrong?


    My tab names are Incomplete and Complete
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Good Day,
      Have you replaced all "Sheet2" in above code with your sheet name "Complete"?
      Would be nice if you can send me your workbook via zxm@addin99.com.

      Thank you for you comment.
  • To post as a guest, your comment is unpublished.
    hdavis2189@gmail.com · 3 years ago
    Hello,

    Thank you for sharing this code, it has proven to be very helpful! I have ran into a bit of a snag, though.

    My issue is that the cells I want to check the value could change columns. In your example you have 3 columns - Name, Team Color, Finish or not - and you want to check "Finish or Not" which is in column C.

    Is there a way to make this code dynamic so that if the "Finish or Not" was to move to column F it would search and copy the correct data?

    Set xRg = Worksheets("Sheet1").Range("C1:C" & I) Set xRg = Worksheets("Sheet1").Range(????)
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Dear Hank Davis,
      Please change the code Set xRg = Worksheets("Sheet1").Range("C1:C" & I) to
      Set xRg = Worksheets("Sheet1").Range("C:F").
      Thank you for your comment.
      • To post as a guest, your comment is unpublished.
        ttacco22@gmail.com · 3 years ago
        Hello I have in the past used VBA to do certain things in Office and have forgotten more than I remember. That being said, I am using Microsoft Window 7 Home Premium with an older version of Microsoft Office (am thinking 2003).
        I have a spreadsheet I am using to track my media collection of mp4s and such. By using a dir command in Command box to output a txt file that I parse to render cells with path to the media (mainly mp4s) and the actual filename.mp4.
        What I am trying to accomplish is to move every row with a cell with a filename.mp4 to another sheet.
        This is my code thus far:
        Sub MoveMp4()
        'Private Sub Worksheet_Change(ByVal Target As Range) [[use this as top line to run automatically if desired]]
        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) 'This would never work for me as C is too low HAS TO BE E THRU I AS IN THE BELOW
        Set xRg = Worksheets("Sheet1").Range("E:I") '[[ADDED THIS AS THE RANGE CHANGES
        DYNAMICALLY]]
        On Error Resume Next
        Application.ScreenUpdating = False
        For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = ".mp4" Then
        xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
        xRg(K).EntireRow.Delete
        If CStr(xRg(K).Value) = ".mp4" Then
        K = K - 1
        End If
        J = J + 1
        End If
        Next
        Application.ScreenUpdating = True
        End Sub
        Again, this code works if a single cell in range E:I contains .mp4 yet will not move the row if there are characters before the .mp4 (as most filenames would be) and thus my use of filename.mp4 in description above.
        Apologies for the length of the post yet I wanted to be clear as to what I desire as opposed to going back and forth with explainations.
        And finally I should like to add that, you people are doing a great service to the community of the world, Thank You from the bottom of my heart soul and mind!
        • To post as a guest, your comment is unpublished.
          crystal · 3 years ago
          Dear Anthony Tacco,
          Do you mean moving row based on content ".mp4" in certain column even there are characters before or after the .mp4?
          Do you mind sending your workbook to me via zxm@addin99.com?
          • To post as a guest, your comment is unpublished.
            ttacco22@gmail.com · 3 years ago
            Last Friday (03-30-18). I replied to an email with regard to your response to my post, with workbook and related data. I just forwarded it the email address listed here (zxm@addin99.com). Please let me know if anyone has received it. Thank You
  • To post as a guest, your comment is unpublished.
    Hank · 3 years ago
    Hello,

    Thank you for sharing this code, it has proven to be very helpful! I have ran into a bit of a snag, though.

    My issue is that the cells I want to check the value could change columns. In your example you have 3 columns - Name, Team Color, Finish or not - and you want to check "Finish or Not" which is in column C.

    Is there a way to make this code dynamic so that if the "Finish or Not" was to move to column F it would search and copy the correct data?

    Set xRg = Worksheets("Sheet1").Range("C1:C" & I) -> Set xRg = Worksheets("Sheet1").Range(????)
  • To post as a guest, your comment is unpublished.
    refad0312@gmail.com · 3 years ago
    hello,
    can u help me ??
  • To post as a guest, your comment is unpublished.
    SabinaM · 3 years ago
    Hello.


    Your chat was a great help and exactly what i was looking for. VBA code work perfectly, however, i can not make work automation VBA code you have responded with to billy 2 months ago. Should i add it to the original one or keep separate? Also is it possible to make moved raw keep format?
    i am totally new in VBA and would appreciate your help.

    Thank you,

    Sabina
  • To post as a guest, your comment is unpublished.
    Sabina · 3 years ago
    Hello.


    Your chat was a great help and exactly what i was looking for. VBA code work perfectly, however, i can not make work automation VBA code you have responded with to billy 2 months ago. Should i add it to the original one or keep separate? Also is it possible to make moved raw keep format?
    i am totally new in VBA and would appreciate your help.

    Thank you,

    Sabina
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Dear Sabina,
      You need to put the code into another code window. And the cell format will be kept when moving.
      Please open the Sheet1 code window instead of the Module window, and the copy the below VBA code into the window.

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      On Error Resume Next
      Application.ScreenUpdating = False
      If Target.Count = 1 And Intersect(Target, Columns(3)) Then
      I = ActiveSheet.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
      If Target.Value = "Done" Then
      Target.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      Target.EntireRow.Delete
      End If
      End If
      Application.ScreenUpdating = True
      End Sub
      • To post as a guest, your comment is unpublished.
        SabinaM · 3 years ago
        Dear Crystal,

        Just found out that it glitches with all conditional formatting and auto-formatted table. Manual VBA code works well though. any advises on that?
      • To post as a guest, your comment is unpublished.
        SabinaM · 3 years ago
        Dear Crystal,


        I have found it, please ignore my previous message. - Works amazing. THANK YOU.
      • To post as a guest, your comment is unpublished.
        SabinaM · 3 years ago
        Dear Crystal,
        Thank you very much for your help with VBA code for formatting and automation. Appreciate your time. Feeling bad to ask, but could you please advice where to find "Sheet1 code window". Perhaps its a silly question, but its my second time opening VBA. Thank you. S
        • To post as a guest, your comment is unpublished.
          crystal · 3 years ago
          Dear Sabina,
          Please open the Microsoft Visual Basic for Applications window by pressing the Alt + F11 keys, and then double click Sheet1 in the left VBAProject pane to open the Sheet1 Code window as below screenshot shown. Hope I can help. Thank you.
          • To post as a guest, your comment is unpublished.
            SabinaM · 3 years ago
            Dear Crystal,
            Thank you very much, indeed. I know where to find it now and your VBA code worked, although i have few conditional formats and entire table is auto-formated and when i pull them down to copy all file glitches. But original VBA codes works with no problems.Thank you S.
  • To post as a guest, your comment is unpublished.
    Jay P · 3 years ago
    Thanks for this, works great! How do I make VBA Code 2 automatic instead of hitting F5 every time?
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Good Day,
      Copy the VBA code 2 into the Sheet1 code window instead of the Module window, then replace the first line of the code with: Private Sub Worksheet_Change(ByVal Target As Range)
  • To post as a guest, your comment is unpublished.
    bourgoin.rene@yahoo.ca · 3 years ago
    I Really Like the code and it works really good. I am using the first one that moves to the second sheet and delete the entire row of the source. How can I modify it a little so it only moves the values between columns C:J of that row to the second sheet. Then do a clear content between C:J of that row as well. Sorry I am new to vba and I tried a few things and failed :-(


    Any help will be very appreciated
    thanks in advance.
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Dear Rene,
      The below VBA code can help you solve the problem. Thank you for your comment.

      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
      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
      Debug.Print xRg(K).Resize(1, 8).Address
      xRg(K).Resize(1, 8).Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      xRg(K).Resize(1, 8).Clear
      J = J + 1
      End If
      Next
      Application.ScreenUpdating = True
      End Sub
      • To post as a guest, your comment is unpublished.
        Britney · 3 years ago
        I'm not sure what I'm doing wrong. I didn't want to ask the same question other people have asked, but I couldn't find my answer in the comments, so here it is.

        I used the VBA code 2 from the original article to copy the information from sheet1 to sheet2. I only want to copy the information in Columns A:G. After reading this code, I changed the original line of code: "xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)" to the two lines "Debug.Print xRg(K).Resize(1, 7).Address
        xRg(K).Resize(1, 7).Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)". After running the code, nothing populates. I'm not sure what I'm doing wrong. Please help!
  • To post as a guest, your comment is unpublished.
    SHER · 4 years ago
    IF I WANT TO MOVE THE ROW TO THE BOTTOM OF ANOTHER SHEETS DATA HOW DO I DO THAT?
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Dear SHER,
      If data already exists in the destination worksheet, after running the code, the row will be moved to the bottom of the original data automatically.
  • To post as a guest, your comment is unpublished.
    Bre · 4 years ago
    Crystal- disregard previous question. I got that part figured out. However, my issue is that if row 27 column F gets changed to Paid than everything under it (rows 28-41) get moved over to the spreadsheet as well even though those are still in "sent" status.