Прескочи на основното съдържание

Как да преместите целия ред в друг лист въз основа на стойността на клетката в Excel?

Автор: Силувия Последна промяна: 2020-04-28

За преместване на целия ред в друг лист въз основа на стойността на клетка, тази статия ще ви помогне.

Преместване на целия ред в друг лист въз основа на стойността на клетка с VBA код
Преместете целия ред в друг лист въз основа на стойността на клетката с Kutools за Excel


Преместване на целия ред в друг лист въз основа на стойността на клетка с VBA код

Както е показано на екранната снимка по-долу, трябва да преместите целия ред от Sheet1 към Sheet2, ако в колона C съществува конкретна дума „Готово“. Можете да опитате следния VBA код.

1. Натиснете Друг+ F11 клавиши едновременно, за да отворите Microsoft Visual Basic за приложения прозорец.

2. В прозореца на Microsoft Visual Basic за приложения щракнете Поставете > Модули. След това копирайте и поставете VBA кода по-долу в прозореца.

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

Забележка: В кода, Sheet1 е работният лист съдържа реда, който искате да преместите. И Sheet2 е целевият работен лист, където ще намерите реда. “C:C” е колоната, която съдържа определена стойност и думата „Направен” е определената стойност, въз основа на която ще преместите ред. Моля, променете ги според вашите нужди.

3. Натисни F5 за изпълнение на кода, тогава редът, който отговаря на критериите в Sheet1, ще бъде преместен незабавно в Sheet2.

Забележка: Горният VBA код ще изтрие редове от оригиналните данни след преместване в определен работен лист. Ако искате само да копирате редове въз основа на стойността на клетката, вместо да ги изтривате. Моля, приложете следния VBA код 2.

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

Преместете целия ред в друг лист въз основа на стойността на клетката с Kutools за Excel

Ако сте начинаещ във VBA кода. Тук представям Изберете конкретни клетки полезност на Kutools за Excel. С тази помощна програма можете лесно да изберете всички редове въз основа на определена стойност на клетка или различни стойности на клетка в работен лист и да копирате избраните редове в целевия работен лист, както ви е необходимо. Моля, направете следното.

Преди да кандидатствате Kutools за Excel, Моля те първо го изтеглете и инсталирайте.

1. Изберете списъка с колони, който съдържа стойността на клетката, въз основа на която ще премествате редове, след което щракнете Kutools > Изберете > Изберете конкретни клетки. Вижте екранна снимка:

2. В откриването Изберете конкретни клетки диалогов прозорец, изберете Цял ред в Тип селекция раздел, изберете Равно на в Специфичен тип падащ списък, въведете стойността на клетката в текстовото поле и след това щракнете върху OK бутон.

Друг Изберете конкретни клетки изскача диалогов прозорец, за да ви покаже броя на избраните редове, а междувременно всички редове съдържат определената стойност в избраната колона са избрани. Вижте екранна снимка:

3. Натисни Ctrl + C клавиши, за да копирате избраните редове и след това да ги поставите в целевия работен лист, от който се нуждаете.

Забележка: Ако искате да преместите редове в друг работен лист въз основа на две различни стойности на клетка. Например, преместете редове въз основа на стойностите на клетката или „Готово“, или „Обработка“, можете да активирате Or състояние в Изберете конкретни клетки диалогов прозорец, както е показано на екранната снимка по-долу:

  Ако искате да имате безплатен пробен период (30 дни) на тази помощна програма, моля, щракнете, за да го изтеглитеи след това преминете към прилагане на операцията съгласно горните стъпки.


Свързани статии:

Най-добрите инструменти за продуктивност в офиса

🤖 Kutools AI помощник: Революционизирайте анализа на данни въз основа на: Интелигентно изпълнение   |  Генериране на код  |  Създаване на персонализирани формули  |  Анализирайте данни и генерирайте диаграми  |  Извикване на функциите на Kutools...
Популярни функции: Намерете, маркирайте или идентифицирайте дубликати   |  Изтриване на празни редове   |  Комбинирайте колони или клетки без загуба на данни   |   Кръг без формула ...
Супер търсене: VLookup с множество критерии    VLookup с множество стойности  |   VLookup в няколко листа   |   Размито търсене ....
Разширен падащ списък: Бързо създаване на падащ списък   |  Зависим падащ списък   |  Падащ списък с множество избори ....
Мениджър на колони: Добавете конкретен брой колони  |  Преместване на колони  |  Превключване на състоянието на видимост на скритите колони  |  Сравнете диапазони и колони ...
Препоръчани функции: Мрежов фокус   |  Изглед на дизайна   |   Голям формула бар    Мениджър на работни книги и листове   |  Библиотека с ресурси (Автоматичен текст)   |  Избор на дата   |  Комбинирайте работни листове   |  Шифроване/декриптиране на клетки    Изпращайте имейли по списък   |  Супер филтър   |   Специален филтър (филтър получер/курсив/зачертано...) ...
Топ 15 комплекта инструменти12 Текст Инструменти (добавяне на текст, Премахване на символи, ...)   |   50 + Графика Видове (диаграма на Гант, ...)   |   40+ Практичен формули (Изчислете възрастта въз основа на рождения ден, ...)   |   19 вмъкване Инструменти (Въведете QR код, Вмъкване на картина от пътя, ...)   |   12 Конверсия Инструменти (Числа към думи, Валутен обмен, ...)   |   7 Обединяване и разделяне Инструменти (Разширено комбиниране на редове, Разделени клетки, ...)   |   ... и още

Усъвършенствайте уменията си за Excel с Kutools за Excel и изпитайте ефективност, както никога досега. Kutools за Excel предлага над 300 разширени функции за повишаване на производителността и спестяване на време.  Щракнете тук, за да получите функцията, от която се нуждаете най-много...

Описание


Раздел Office Внася интерфейс с раздели в Office и прави работата ви много по-лесна

  • Разрешете редактиране и четене с раздели в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
  • Отваряйте и създавайте множество документи в нови раздели на един и същ прозорец, а не в нови прозорци.
  • Увеличава вашата производителност с 50% и намалява стотици кликвания на мишката за вас всеки ден!
Comments (306)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hi,

I have a workbook with 9 sheets, the last 3 of which are irrelevant in terms of what I'm hoping to do. I keep all my data on Sheet1 (Sheet Name Withdrawn). I have used a code found here and modified it slightly to get closer to what I desire, but there are just a few features that I'm missing. Sheet1, Column B has a dropdown list. Lets call the dropdown choices "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Irrelevant1", "Irrelevant2", "Irrelevant3". On Sheet1, Column B, if "Sheet2" is chosen, I want that whole row to be copy and pasted into the first empty row on Sheet2. If "Sheet3" is chosen, I want the whole row to be copy and pasted to the first empty row in Sheet3. I want this same concept for choices "Sheet4", "Sheet5", and "Sheet6". I have accomplished all of this with the code I am using currently. I have also assigned a button to run this Macro.

Here's where I am coming up short from my ideal concept. I also want this to work so that when the choice in Sheet1, Column B is changed, it eliminates that row on the sheet that it was originally copy and pasted to. For instance, lets say I originally choose "Sheet2" from Column B in Sheet1, and therefore it copy and pastes this row to the first empty row in Sheet2. However, later I decide to change my choice in Sheet1, ColumnB for this row to "Sheet3". After hitting my button assigned to this Macro (Or better yet, if this process can somehow be automated), I want it to remove it from Sheet2 and now copy and paste it into Sheet 3, since that is what is chosen now in Sheet 1, Column B for that row. Also, if the choice in Sheet1, ColumnB is changed to "Irrelevant1", "Irrelevant2", or "Irrelevant3", I want it to remove it from all other sheets except Sheet1. Lastly, if a row is already copy and pasted to Sheet2, Sheet3, Sheet4, Sheet5, or Sheet6, I don't want it to be added again when the Macro is run again, which is what I have currenlty happening with my existing code.

Hope this isn't too hard to follow. I can share my workbook if it helps.
This comment was minimized by the moderator on the site
Thank you so much for this! It works very well, except like others who have commented -- I want the rows that move to be pasted in the first empty row. Is there a way to have it do that instead of going to the same row on the new sheet? Currently, if row 9 moves to a different sheet, it also fills row 9 on the new sheet. Thanks!

Code is:

Sub Done()
'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("Big KS Comms List").UsedRange.Rows.Count
J = Worksheets("DONE").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("DONE").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Big KS Comms List").Range("D1:D" & 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("DONE").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
This comment was minimized by the moderator on the site
dear Crystal,

thank you very much for your help but I require your guidance once more 😅

I'm using your code as Module for my worksheet to move finished inquiries, as follow:

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("Master").UsedRange.Rows.Count
J = Worksheets("Delivered").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Delivered").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Master").Range("M1:M" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Delivered" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Delivered").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Delivered" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub


Also, to add date and time automatically, I'm using this code which doesn't seem to be working well with the Module:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range: Set M = Range("M:M")
Dim v As String
If Intersect(Target, M) Is Nothing Then Exit Sub

Application.EnableEvents = False
v = Target.Value
If v = "Agent Received" Then Target.Offset(0, 4) = Now()
If v = "Ready for Dispatch" Then Target.Offset(0, 2) = Now()
If v = "In Transit" Then Target.Offset(0, 3) = Now()
If v = "Delivered" Then Target.Offset(0, 5) = Now()
Application.EnableEvents = True
End Sub

by running the module, I end up with Error 13 type mismatch. Is there a way to fix this ?
Thank you.
This comment was minimized by the moderator on the site
Thank you very much for your help, all works fine.

for me it seems i have to Alt+F8 and run the module every time to get the rules working and rows moving.

is there a way to automate it ? thank you
This comment was minimized by the moderator on the site
Hi,

In the worksheet that contains the rows you want to move based on cell values, right-click the Worksheet tab and click View Code from the context menu, then add the following VBA code to the Worksheet (Code) window.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated by Kutools for Excel 2023/11/17
    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
This comment was minimized by the moderator on the site
I am using this code- it works OK BUT seems to be RANDOMLY placing the data on the Completed worksheet. I do not want it to overwrite any data- I would like it to ADD rows to a table or just to the spreadsheet.

Sub MoveRowsToComplete()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("To-Do List").UsedRange.Rows.Count
J = Worksheets("Completed").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Completed").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("To-Do List").Range("C1:C" & 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").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
This comment was minimized by the moderator on the site
I am moving the row from a table in one sheet to a table in another sheet, the issue I am having the row being moved over to the first available row in the table. It always moves it to the end of the table or the row after the end of the table. Are you able to provide any insight?
This comment was minimized by the moderator on the site
This has been the most helpful post! I have been trying to figure this out for a couple of weeks now and I can finally get my row to move. My question is. I have many tabs at the bottom and depending on the status in a specific column I would like them to go to that specific spreadsheet. I feel like I really configure it when I try to put more subs in.

Essentially, I have 8 tabs (worksheets) at the bottom and a drop down of statuses in column V of each of those tabs.
I would like to be able for the data to move and from worksheet to worksheet as needed based on the status.

I am only able to get this done for one (Form 1 to First Call)

Thank you for any help on being able to put multiple subs to get this accomplished.
This comment was minimized by the moderator on the site
Thanks for the superb code. I had to modify it a bit to make it work in connection with a project I had and found that it was less error prone in my version to have the for loop run in reverse and stepping back -1 which also eliminates the need for the K = K - 1 code line.
This comment was minimized by the moderator on the site
Wow! I love all the assistance you provide! Very cool!

Wondering if you may be able to help me...I have a workbook with two worksheets...One is for "Open Orders" and one is for "Closed Orders".

Currently, I have it set up so that there is a drop down list to determine if the work order is still open or in to be moved into closed status. When I choose "Closed" from the drop down list, I then hit Ctl/Shift/J and it moves it to the "Closed Orders" sheet adding it to the bottom row of the sheet. I then click on the "Closed Orders" sheet tab and use code to hit ctrl/shift/K to sort by the work order number.

Is there a way to automate everything so that when Idesignate the work order as "Closed" in the "Open Orders" sheet that it moves it to the "Closed Orders" sheet AND sorts by work order without having to do the ctrl/shift function in each sheet?

Thank you in advance for your assistance!!

Deb
This comment was minimized by the moderator on the site
Hi Deb,
I don't quite understand the "Sort" part you memtioned. Do you mind uploading your sample file here.
This comment was minimized by the moderator on the site
Hello, I posted a comment a moment ago but realised I completely mucked it up, so let's try again!

I'm trying to use this code but need to make a few tweaks and can't figure out how.

The value I'm looking for is "Unplanned" and needs to be in column H, but from H3 down (exclude H1 and H2).
Instead of copying the entire row, I need to copy from A:D.
When pasting into the next sheet, I need it to start at A3.

Any help would be greatly appreciated!
Thanks 😊
This comment was minimized by the moderator on the site
Ho Tess Laughlin,
The following code can help you solve the problem. Please give it a try. Thank you.
Sub Cheezy()
    'Updated by Kutools for Excel 20221128
    Dim xRg As Range
    Dim xStr As String
    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 = 2
    End If
    Set xRg = Intersect(Range("H3:H1048576"), Worksheets("Sheet1").UsedRange)
    If xRg Is Nothing Then Exit Sub
    
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Unplanned" Then
            xStr = CStr(K + 2)
            Range("A" & xStr & ":D" & xStr).Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub
This comment was minimized by the moderator on the site
This is great, thanks so much! :)
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations