انتقل إلى المحتوى الرئيسي

كيفية نقل صف بأكمله إلى ورقة أخرى بناءً على قيمة الخلية في إكسيل؟

لنقل صف بأكمله إلى ورقة أخرى بناءً على قيمة الخلية ، ستساعدك هذه المقالة.

انقل الصف بأكمله إلى ورقة أخرى بناءً على قيمة الخلية برمز VBA
انقل صفًا بأكمله إلى ورقة أخرى بناءً على قيمة الخلية باستخدام Kutools for Excel


انقل الصف بأكمله إلى ورقة أخرى بناءً على قيمة الخلية برمز VBA

كما هو موضح أدناه ، تحتاج إلى نقل الصف بأكمله من Sheet1 إلى Sheet2 إذا كانت كلمة معينة "Done" موجودة في العمود C. يمكنك تجربة رمز VBA التالي.

1. صحافة قديم+ F11 مفاتيح في نفس الوقت لفتح ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

2. في نافذة ميكروسوفت فيسوال باسيك للتطبيقات ، انقر فوق إدراج > وحدة. ثم انسخ والصق رمز فبا أدناه في النافذة.

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 هي ورقة العمل الوجهة التي ستحدد فيها الصف. "ج: ج"هو العمود الذي يحتوي على قيمة معينة ، وكلمة"تم. "هي القيمة المحددة التي ستنقل الصف بناءً عليها. يرجى تغييرها بناءً على احتياجاتك.

3. اضغط على F5 مفتاح لتشغيل التعليمات البرمجية ، ثم سيتم نقل الصف الذي يفي بالمعايير في الورقة 1 إلى الورقة 2 على الفور.

ملاحظات: سيؤدي رمز فبا أعلاه إلى حذف الصفوف من البيانات الأصلية بعد الانتقال إلى ورقة عمل محددة. إذا كنت تريد فقط نسخ الصفوف بناءً على قيمة الخلية بدلاً من حذفها. يرجى تطبيق كود 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 for Excel

إذا كنت مبتدئًا في كود VBA. هنا أقدم ملف حدد خلايا معينة فائدة كوتولس ل إكسيل. باستخدام هذه الأداة المساعدة ، يمكنك بسهولة تحديد جميع الصفوف بناءً على قيمة خلية معينة أو قيم خلية مختلفة في ورقة العمل ، ونسخ الصفوف المحددة إلى ورقة العمل الوجهة حسب حاجتك. الرجاء القيام بما يلي.

قبل التطبيق كوتولس ل إكسيلالرجاء قم بتنزيله وتثبيته أولاً.

1. حدد قائمة الأعمدة التي تحتوي على قيمة الخلية التي ستنقل الصفوف بناءً عليها ، ثم انقر فوق كوتولس > أختار > حدد خلايا معينة. انظر لقطة الشاشة:

2. في الافتتاح حدد خلايا معينة مربع الحوار، اختر الصف بأكمله في ال نوع التحديد القسم، حدد يساوي في ال نوع خاص أو معين القائمة المنسدلة ، أدخل قيمة الخلية في مربع النص ، ثم انقر فوق OK .

آخر حدد خلايا معينة ينبثق مربع الحوار لإظهار عدد الصفوف المحددة ، وفي الوقت نفسه ، تم تحديد جميع الصفوف التي تحتوي على القيمة المحددة في العمود المحدد. انظر لقطة الشاشة:

3. اضغط على CTRL + C لنسخ الصفوف المحددة ، ثم لصقها في ورقة العمل الوجهة التي تريدها.

ملاحظات: إذا كنت تريد نقل الصفوف إلى ورقة عمل أخرى بناءً على قيمتين مختلفتين للخلية. على سبيل المثال ، حرك الصفوف بناءً على قيم الخلية إما "تم" أو "معالجة" ، يمكنك تمكين Or الشرط في حدد خلايا معينة مربع الحوار كما هو موضح أدناه لقطة الشاشة:

  إذا كنت ترغب في الحصول على نسخة تجريبية مجانية (30 يومًا) من هذه الأداة المساعدة ، الرجاء الضغط لتنزيلهثم انتقل لتطبيق العملية حسب الخطوات المذكورة أعلاه.


مقالات ذات صلة:

أفضل أدوات إنتاجية المكتب

🤖 مساعد Kutools AI: إحداث ثورة في تحليل البيانات على أساس: التنفيذ الذكي   |  إنشاء التعليمات البرمجية  |  إنشاء صيغ مخصصة  |  تحليل البيانات وإنشاء الرسوم البيانية  |  استدعاء وظائف Kutools...
الميزات الشعبية: البحث عن التكرارات أو تمييزها أو تحديدها   |  حذف الصفوف الفارغة   |  دمج الأعمدة أو الخلايا دون فقدان البيانات   |   جولة بدون صيغة 
سوبر بحث: معايير متعددة VLookup    VLookup ذات القيمة المتعددة  |   VLookup عبر أوراق متعددة   |   بحث غامض ....
قائمة منسدلة متقدمة: إنشاء القائمة المنسدلة بسرعة   |  القائمة المنسدلة التابعة   |  قائمة منسدلة متعددة التحديد ....
مدير العمود: إضافة عدد محدد من الأعمدة  |  نقل الأعمدة  |  تبديل حالة رؤية الأعمدة المخفية  |  مقارنة النطاقات والأعمدة 
الميزات المميزة: التركيز على الشبكة   |  عرض تصميم   |   شريط الفورمولا الكبير    مدير المصنفات والأوراق   |  مكتبة الموارد (النص السيارات)   |  منتقي التاريخ   |  اجمع أوراق العمل   |  تشفير/فك تشفير الخلايا    إرسال رسائل البريد الإلكتروني عن طريق القائمة   |  سوبر تصفية   |   مرشح خاص (تصفية غامق / مائل / يتوسطه خط ...) ...
أفضل 15 مجموعة أدوات12 نص الأدوات (إضافة نص, إزالة الأحرف، ...)   |   +50 رسم الأنواع (مخطط جانت، ...)   |   40+ عملي الصيغ (احسب العمر على أساس تاريخ الميلاد، ...)   |   19 إدخال الأدوات (أدخل رمز الاستجابة السريعة, إدراج صورة من المسار، ...)   |   12 تحويل الأدوات (أرقام إلى كلمات, نتيجة تحويل عملة، ...)   |   7 دمج وتقسيم الأدوات (الجمع بين الصفوف المتقدمة, تقسيم الخلايا، ...)   |   ... و اكثر

عزز مهاراتك في Excel باستخدام Kutools for Excel، واختبر كفاءة لم يسبق لها مثيل. يقدم Kutools for Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية وتوفير الوقت.  انقر هنا للحصول على الميزة التي تحتاجها أكثر...

الوصف


يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 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