Μετάβαση στο κύριο περιεχόμενο

Πώς να μετακινήσετε ολόκληρη τη σειρά σε άλλο φύλλο με βάση την τιμή κελιού στο Excel;

Για να μετακινήσετε ολόκληρη τη σειρά σε άλλο φύλλο με βάση την τιμή κελιού, αυτό το άρθρο θα σας βοηθήσει.

Μετακίνηση ολόκληρης της σειράς σε άλλο φύλλο με βάση την τιμή κελιού με τον κώδικα VBA
Μετακίνηση ολόκληρης της σειράς σε άλλο φύλλο με βάση την τιμή κελιού με το Kutools για Excel


Μετακίνηση ολόκληρης της σειράς σε άλλο φύλλο με βάση την τιμή κελιού με τον κώδικα VBA

Όπως φαίνεται στο παρακάτω στιγμιότυπο οθόνης, πρέπει να μετακινήσετε ολόκληρη τη σειρά από το Sheet1 στο Sheet2 εάν υπάρχει μια συγκεκριμένη λέξη "Done" στη στήλη C. Μπορείτε να δοκιμάσετε τον ακόλουθο κώδικα VBA.

1. Τύπος άλλος+ F11 ταυτόχρονα για να ανοίξετε το Microsoft Visual Basic για εφαρμογές παράθυρο.

2. Στο παράθυρο της Microsoft Visual Basic for Applications, κάντε κλικ στο Κύριο θέμα > Μονάδα μέτρησης. Στη συνέχεια, αντιγράψτε και επικολλήστε τον παρακάτω κώδικα 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

Note: Στον κώδικα, Sheet1 είναι το φύλλο εργασίας περιέχει τη σειρά που θέλετε να μετακινήσετε. Και Sheet2 είναι το φύλλο εργασίας προορισμού όπου θα βρείτε τη σειρά. «Γ: Γ"Είναι η στήλη περιέχει τη συγκεκριμένη τιμή και τη λέξη"Ολοκληρώθηκε"Είναι η συγκεκριμένη τιμή βάσει της οποίας θα μετακινήσετε τη σειρά. Αλλάξτε τα ανάλογα με τις ανάγκες σας.

3. Πάτα το F5 για να εκτελέσετε τον κωδικό, τότε η σειρά που πληροί τα κριτήρια στο Φύλλο1 θα μετακινηθεί αμέσως στο Φύλλο2

Note: Ο παραπάνω κώδικας 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 για να αντιγράψετε τις επιλεγμένες σειρές και, στη συνέχεια, να τις επικολλήσετε στο φύλλο εργασίας προορισμού που χρειάζεστε.

Note: Εάν θέλετε να μετακινήσετε σειρές σε άλλο φύλλο εργασίας με βάση δύο διαφορετικές τιμές κελιών. Για παράδειγμα, μετακινήστε σειρές με βάση τις τιμές κελιού είτε "Τέλος" είτε "Επεξεργασία", μπορείτε να ενεργοποιήσετε το Or κατάσταση στο Επιλέξτε συγκεκριμένα κελιά πλαίσιο διαλόγου όπως φαίνεται παρακάτω το στιγμιότυπο οθόνης:

  Εάν θέλετε να έχετε μια δωρεάν δοκιμή (30-ημερών) αυτού του βοηθητικού προγράμματος, κάντε κλικ για να το κατεβάσετεκαι μετά πηγαίνετε για να εφαρμόσετε τη λειτουργία σύμφωνα με τα παραπάνω βήματα.


Σχετικά Άρθρα:

Τα καλύτερα εργαλεία παραγωγικότητας γραφείου

🤖 Kutools AI Aide: Επανάσταση στην ανάλυση δεδομένων με βάση: Ευφυής Εκτέλεση   |  Δημιουργία κώδικα  |  Δημιουργία προσαρμοσμένων τύπων  |  Αναλύστε δεδομένα και δημιουργήστε γραφήματα  |  Επίκληση Λειτουργιών Kutools...
Δημοφιλή χαρακτηριστικά: Εύρεση, επισήμανση ή αναγνώριση διπλότυπων   |  Διαγραφή κενών γραμμών   |  Συνδυάστε στήλες ή κελιά χωρίς απώλεια δεδομένων   |   Γύρος χωρίς φόρμουλα ...
Σούπερ Αναζήτηση: VLookup πολλαπλών κριτηρίων    VLookup πολλαπλών τιμών  |   VLookup σε πολλά φύλλα   |   Ασαφής αναζήτηση ....
Σύνθετη αναπτυσσόμενη λίστα: Γρήγορη δημιουργία αναπτυσσόμενης λίστας   |  Εξαρτημένη αναπτυσσόμενη λίστα   |  Πολλαπλή αναπτυσσόμενη λίστα ....
Διαχειριστής στήλης: Προσθέστε έναν συγκεκριμένο αριθμό στηλών  |  Μετακίνηση στηλών  |  Εναλλαγή κατάστασης ορατότητας κρυφών στηλών  |  Συγκρίνετε εύρη και στήλες ...
Επιλεγμένα Χαρακτηριστικά: Εστίαση πλέγματος   |  Προβολή σχεδίου   |   Μεγάλη Formula Bar    Διαχείριση βιβλίου εργασίας & φύλλου   |  Βιβλιοθήκη πόρων (Αυτόματο κείμενο)   |  Επιλογή ημερομηνίας   |  Συνδυάστε φύλλα εργασίας   |  Κρυπτογράφηση/Αποκρυπτογράφηση κελιών    Αποστολή email ανά λίστα   |  Σούπερ φίλτρο   |   Ειδικό φίλτρο (φίλτρο με έντονη γραφή/πλάγια γραφή/διαγραφή...) ...
Κορυφαία 15 σύνολα εργαλείων12 Κείμενο Εργαλεία (Προσθήκη κειμένου, Κατάργηση χαρακτήρων, ...)   |   50 + Διάγραμμα Τύποι (Gantt διάγραμμα, ...)   |   40+ Πρακτικό ΜΑΘΗΜΑΤΙΚΟΙ τυποι (Υπολογίστε την ηλικία με βάση τα γενέθλια, ...)   |   19 Εισαγωγή Εργαλεία (Εισαγωγή κωδικού QR, Εισαγωγή εικόνας από το μονοπάτι, ...)   |   12 Μετατροπή Εργαλεία (Αριθμοί σε λέξεις, Μετατροπή Συναλλάγματος, ...)   |   7 Συγχώνευση & διαχωρισμός Εργαλεία (Σύνθετες σειρές συνδυασμού, Διαίρεση κελιών, ...)   |   ... κι αλλα

Αυξήστε τις δεξιότητές σας στο Excel με τα Kutools για Excel και απολαύστε την αποτελεσματικότητα όπως ποτέ πριν. Το Kutools για Excel προσφέρει πάνω από 300 προηγμένες δυνατότητες για την ενίσχυση της παραγωγικότητας και την εξοικονόμηση χρόνου.  Κάντε κλικ εδώ για να αποκτήσετε τη δυνατότητα που χρειάζεστε περισσότερο...

Περιγραφή


Το Office Tab φέρνει τη διεπαφή με καρτέλες στο 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