팁 : 다른 언어는 Google 번역입니다. 방문하실 수 있습니다. English 이 링크의 버전.
로그인
x
or
x
x
회원가입
x

or

Excel에서 셀 값을 기반으로 행 전체를 다른 시트로 이동하는 방법?

셀 값을 기준으로 행 전체를 다른 시트로 이동하려면이 도움말을 참조하십시오.

VBA 코드로 셀 값을 기반으로 전체 행을 다른 시트로 이동

Excel 용 Kutools로 셀 값을 기반으로 전체 행을 다른 시트로 이동


Certian 열의 셀 값을 기반으로 전체 행을 쉽게 선택할 수 있습니다.

특정 셀 선택 ~의 유용성 Excel 용 Kutools Excel의 certian 열에있는 셀 값을 기반으로 전체 행을 신속하게 선택하는 데 도움이됩니다 (아래 스크린 샷 참조). 셀 값을 기반으로 모든 행을 선택한 후에 Excel에서 필요에 따라 수동으로 새 위치로 이동하거나 복사 할 수 있습니다.

Excel 용 Kutools: 200 이상의 편리한 Excel 추가 기능으로 60 일 동안 아무런 제한없이 시도 할 수 있습니다. 무료 평가판을 다운로드하십시오!


VBA 코드로 셀 값을 기반으로 전체 행을 다른 시트로 이동

아래 스크린 샷과 같이 특정 단어 "완료"가 C 열에 있으면 Sheet1에서 Sheet2로 전체 행을 이동해야합니다. 다음 VBA 코드를 시도 할 수 있습니다.

1. 프레스 다른+ F11 키를 동시에 열어 응용 프로그램 용 Microsoft Visual Basic 창.

2. Microsoft Visual Basic for Applications 창에서 다음을 클릭하십시오. 끼워 넣다 > 모듈. 그런 다음 아래 VBA 코드를 복사하여 창에 붙여 넣으십시오.

VBA 코드 1 : 셀 값을 기반으로 전체 시트를 다른 시트로 이동

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

주의 사항: 코드에서, Sheet1 워크 시트에 이동할 행이 들어 있습니까? 과 Sheet2 행을 찾을 대상 워크 시트입니다. "C : C"열에 특정 값이 포함되어 있고 단어"끝난"는 행을 기준으로 이동할 특정 값입니다. 필요에 따라 변경하십시오.

3. 누르세요 F5 키를 눌러 코드를 실행하면 Sheet1의 기준에 맞는 행이 즉시 Sheet2로 이동합니다.

주의 사항: 위의 VBA 코드는 지정된 워크 시트로 이동 한 후 원본 데이터에서 행을 삭제합니다. 셀 값을 기준으로 행을 삭제하는 대신 복사 만하려는 경우 아래 VBA 코드 2을 적용하십시오.

VBA 코드 2 : 셀 값을 기반으로 전체 시트를 다른 시트로 복사

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

Excel 용 Kutools로 셀 값을 기반으로 전체 행을 다른 시트로 이동

VBA 코드에 초보자 인 경우 여기에 나는 특정 셀 선택 ~의 유용성 Excel 용 Kutools. 이 유틸리티를 사용하면 워크 시트의 특정 셀 값이나 다른 셀 값을 기반으로 모든 행을 쉽게 선택할 수 있으며 필요한 경우 선택한 행을 대상 워크 시트에 복사 할 수 있습니다. 다음과 같이하십시오.

Excel 용 Kutools : 300 이상의 편리한 Excel 추가 기능으로 60 일 동안 아무런 제한없이 시도 할 수 있습니다.

1. 열을 선택하면 행을 이동할 셀 값이 포함 된 다음 클릭합니다. Kutools > 고르다 > 특정 셀 선택. 스크린 샷보기 :

2. 오프닝에서 특정 셀 선택 대화 상자에서 전체 행 에서 선택 유형 섹션에서 선택 같음 에서 특정 유형 드롭 다운 목록에서 텍스트 상자에 셀 값을 입력하고 OK 버튼을 클릭합니다.

다른 특정 셀 선택 대화 상자가 선택된 행 수를 보여주기 위해 팝업되고 선택한 열의 지정된 값이 포함 된 모든 행이 선택됩니다. 스크린 샷보기 :

3. 누르세요 Ctrl 키 + C 키를 사용하여 선택한 행을 복사 한 다음 원하는 대상 워크 시트에 붙여 넣으십시오.

주의 사항: 두 개의 다른 셀 값을 기반으로 행을 다른 워크 시트로 이동하려는 경우. 예를 들어 셀 값에 따라 행을 '완료'또는 '처리'로 이동하면 Or 조건 특정 셀 선택 대화 상자는 아래 스크린 샷과 같습니다 :

팁.이 유틸리티의 무료 평가판을 사용하려면 다음으로 이동하십시오. 자유롭게 소프트웨어를 다운로드하십시오. 먼저 위의 단계에 따라 작업을 적용하십시오.


관련 기사:


Excel 용 Kutools는 대부분의 문제를 해결하고 생산성을 80 % 증가시킵니다.

  • 재사용: 빠르게 삽입 복잡한 수식, 차트 그리고 당신이 전에 사용했던 것; 셀 암호화 비밀번호로; 메일 링리스트 만들기 그리고 이메일을 보내 ...
  • 슈퍼 포뮬러 바 (여러 줄의 텍스트와 수식을 쉽게 편집); 레이아웃 읽기 (많은 셀을 쉽게 읽고 편집); 필터링 된 범위에 붙여 넣기...
  • 셀 / 행 / 열 병합 데이터 손실없이; 분할 셀 내용; 중복 행 / 열 결합... 중복 세포 방지; 범위 비교...
  • 복제 또는 고유를 선택하십시오. 행; 빈 행 선택 (모든 세포는 비어있다); 슈퍼 찾기 및 퍼지 찾기 많은 통합 문서에서; 랜덤 선택 ...
  • 정확한 사본 공식 참조를 변경하지 않는 다중 셀; 참조 자동 작성 여러 장에; 글 머리 기호 삽입, 확인란 등 ...
  • 텍스트 추출, 텍스트 추가, 위치 별 제거, 공간 제거; 페이징 소계 생성 및 인쇄; 셀 내용과 주석 간 변환...
  • 수퍼 필터 (필터 구성표를 저장하고 다른 시트에 적용); 고급 정렬 월 / 주 / 일별, 빈도 등; 특수 필터 대담하고 기울임 꼴로
  • 통합 문서와 WorkSheets 결합; 키 열을 기준으로 테이블 병합 데이터를 여러 시트로 분할; 일괄 변환 xls, xlsx 및 PDF...
  • 300 이상의 강력한 기능. Office / Excel 2007-2019 및 365를 지원합니다. 모든 언어를 지원합니다. 기업이나 조직에 쉽게 배포 할 수 있습니다. 30 일 무료 평가판 전체 기능.
kte 탭 201905

Office 탭 Office에 탭 인터페이스를 제공하여 작업을 훨씬 쉽게

  • Word, Excel, PowerPoint에서 탭 편집 및 읽기 사용, 게시자, 액세스, Visio 및 프로젝트.
  • 새 창보다는 동일한 창에서 새 탭으로 여러 문서를 열고 만들 수 있습니다.
  • 50 %만큼 생산성을 높이고 매일 수백 번의 마우스 클릭을 줄입니다!
오피셜
Say something here...
symbols left.
You are guest ( Sign Up? )
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.
    Erica · 2 months ago
    Does this not work if Column C is a drop down?
  • To post as a guest, your comment is unpublished.
    Mike · 2 months 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 · 3 months 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 · 3 months 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 · 26 days 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.
    Natasha Leon · 3 months 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 · 3 months 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 · 3 months 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.
    Aleksandar · 3 months 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 · 4 months 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 · 26 days 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 · 4 months 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 · 4 months 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.
    Hassan Arshad · 4 months 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 · 4 months 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 · 5 months 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 · 3 months 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.
    Andrew · 7 months 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.
    Anne · 9 months 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 · 9 months 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 · 9 months 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 · 8 months 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 · 9 months 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 · 10 months 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 · 4 months 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 · 10 months 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 · 8 months 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.
    CAROL · 11 months 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 · 11 months 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 · 11 months 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.
    tom · 11 months 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 · 1 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.
    Robert Mayer · 1 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 · 11 months 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 · 1 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 · 1 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.
    liam · 1 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 · 9 months 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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.
    D company · 1 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 · 1 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 · 1 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 · 1 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.
    gowtham · 1 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 · 1 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 · 1 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.
        Kim · 1 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 · 1 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.
            Kim · 1 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 · 1 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 · 1 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 · 1 years ago
      Good day,
      Can't help with this. Thanks for your comment.
  • To post as a guest, your comment is unpublished.
    Jessica · 1 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 · 1 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.
    Andrew · 1 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.
    Andrew · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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.
    Beth · 1 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 · 1 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.
    Beth · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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.
    Wendy · 1 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 · 1 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 · 1 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 · 1 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.