Note: The other languages of the website are Google-translated. Back to English

Cum să mutați întregul rând pe o altă foaie pe baza valorii celulei din Excel?

Pentru mutarea întregului rând pe o altă foaie pe baza valorii celulei, acest articol vă va ajuta.

Mutați întregul rând pe o altă foaie pe baza valorii celulei cu cod VBA
Mutați întregul rând pe o altă foaie pe baza valorii celulei cu Kutools pentru Excel


Mutați întregul rând pe o altă foaie pe baza valorii celulei cu cod VBA

Așa cum se arată în imaginea de mai jos, trebuie să mutați întregul rând de la Sheet1 la Sheet2 dacă există un cuvânt specific „Terminat” în coloana C. Puteți încerca următorul cod VBA.

1. presa Alt+ F11 tastele simultan pentru a deschide Microsoft Visual Basic pentru aplicații fereastră.

2. În fereastra Microsoft Visual Basic pentru aplicații, faceți clic pe Insera > Module. Apoi copiați și lipiți codul VBA de mai jos în fereastră.

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

notițe: În cod, Sheet1 este foaia de lucru conține rândul pe care doriți să îl mutați. Și Sheet2 este foaia de lucru de destinație unde veți localiza rândul. „C: C”Este coloana conține o anumită valoare, iar cuvântul„Terminat ”Este valoarea pe care veți muta rândul pe baza căruia. Vă rugăm să le schimbați în funcție de nevoile dvs.

3. apasă pe F5 tasta pentru a rula codul, apoi rândul care îndeplinește criteriile din Sheet1 va fi mutat imediat în Sheet2.

notițe: Codul VBA de mai sus va șterge rândurile din datele originale după trecerea la o foaie de lucru specificată. Dacă doriți să copiați rânduri numai pe baza valorii celulei în loc să le ștergeți. Vă rugăm să aplicați codul VBA 2 de mai jos.

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

Mutați întregul rând pe o altă foaie pe baza valorii celulei cu Kutools pentru Excel

Dacă sunteți începător în codul VBA. Aici prezint Selectați celule specifice utilitatea Kutools pentru Excel. Cu acest utilitar, puteți selecta cu ușurință toate rândurile pe baza unei anumite valori a celulei sau a valorilor diferite ale celulei dintr-o foaie de lucru și puteți copia rândurile selectate în foaia de lucru de destinație după cum aveți nevoie. Vă rugăm să faceți următoarele.

Înainte de a aplica Kutools pentru Excel, Vă rugăm să descărcați-l și instalați-l mai întâi.

1. Selectați lista de coloane conține valoarea celulei pe care veți muta rândurile, apoi faceți clic Kutools > Selectați > Selectați celule specifice. Vedeți captura de ecran:

2. În deschidere Selectați celule specifice caseta de dialog, alegeți Întregul rând în Tipul de selecție secțiune, selectați este egală cu în Tipul specific lista derulantă, introduceți valoarea celulei în caseta de text și apoi faceți clic pe OK butonul.

O alta Selectați celule specifice caseta de dialog apare pentru a vă arăta numărul de rânduri selectate și, între timp, toate rândurile conțin valoarea specificată în coloana selectată au fost selectate. Vedeți captura de ecran:

3. apasă pe Ctrl + C tastele pentru a copia rândurile selectate, apoi lipiți-le în foaia de lucru de destinație de care aveți nevoie.

notițe: Dacă doriți să mutați rândurile într-o altă foaie de lucru pe baza a două valori de celule diferite. De exemplu, mutați rânduri pe baza valorilor celulei fie „Terminat”, fie „Procesare”, puteți activa Or stare în Selectați celule specifice fereastra de dialog prezentată mai jos:

  Dacă doriți să aveți o încercare gratuită (30-zi) a acestei utilitati, vă rugăm să faceți clic pentru a-l descărca, și apoi mergeți pentru a aplica operația conform pașilor de mai sus.


Articole pe aceeași temă:


Cele mai bune instrumente de productivitate Office

Kutools pentru Excel vă rezolvă majoritatea problemelor și vă crește productivitatea cu 80%

  • reutilizarea: Introduceți rapid formule complexe, diagrame și orice ai folosit anterior; Criptați celulele cu parola; Creați o listă de corespondență și trimiteți e-mailuri ...
  • Super Formula Bar (editați cu ușurință mai multe linii de text și formulă); Layout de citire (citiți și editați cu ușurință un număr mare de celule); Lipiți la interval filtrat...
  • Merge celule / rânduri / coloane fără a pierde date; Conținut de celule divizate; Combinați rânduri / coloane duplicate... Prevenirea celulelor duplicate; Comparați gamele...
  • Selectați Duplicat sau Unic Rânduri; Selectați Rânduri goale (toate celulele sunt goale); Super Find și Fuzzy Find în multe cărți de lucru; Selectare aleatorie ...
  • Copie exactă Mai multe celule fără modificarea referinței formulelor; Creați automat referințe la foi multiple; Introduceți gloanțe, Casete de selectare și multe altele ...
  • Extrageți textul, Adăugați text, eliminați după poziție, Eliminați spațiul; Creați și imprimați subtotaluri de paginare; Convertiți conținutul dintre celule și comentarii...
  • Super Filtru (salvați și aplicați scheme de filtrare altor foi); Sortare avansată după lună / săptămână / zi, frecvență și multe altele; Filtru special cu bold, italic ...
  • Combinați cărți de lucru și foi de lucru; Merge Tables pe baza coloanelor cheie; Împărțiți datele în mai multe foi; Conversia în loturi xls, xlsx și PDF...
  • Peste 300 de funcții puternice. Suportă Office / Excel 2007-2021 și 365. Acceptă toate limbile. Implementare ușoară în întreprinderea sau organizația dvs. Funcții complete Probă gratuită de 30 de zile. Garanție de returnare a banilor de 60 de zile.
fila kte 201905

Fila Office aduce interfața cu file în Office și vă face munca mult mai ușoară

  • Activați editarea și citirea cu file în Word, Excel, PowerPoint, Publisher, Access, Visio și Project.
  • Deschideți și creați mai multe documente în filele noi ale aceleiași ferestre, mai degrabă decât în ​​ferestrele noi.
  • Vă crește productivitatea cu 50% și reduce sute de clicuri de mouse pentru dvs. în fiecare zi!
fundul officetab
Comentarii (299)
Încă nu există evaluări. Fii primul care evaluează!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună ziua, am găsit acest ghid deosebit de util față de altele pe care le-am văzut. Mulțumesc! Problema pe care o întâmpin este că, dacă schimb valoarea dorită la „Închis”, trebuie să rulez F5 pentru a muta rândul. Aș dori să se miște automat. Sunt nou în Excel, așa că asistența dumneavoastră este foarte apreciată. Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Foi de lucru ("ECR Incident Tracker").UsedRange.Rows.Count J = Foi de lucru ("Probleme rezolvate").UsedRange.Rows. Count If J = 1 Then If Application.WorksheetFunction.CountA(Worksheets("Resolved Issues").UsedRange) = 0 Then J = 0 End If Set xRg = Worksheets("ECR Incident Tracker").Range("B1:B" & I) În caz de eroare, reluați următoarea aplicație.ScreenUpdating = False pentru fiecare xCell din xRg Dacă CStr(xCell.Value) = „Închis” Apoi xCell.EntireRow.Copy Destination:=Worksheets(„Resolved Issues”).Range(„A” & J + 1) xCell.EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, Încerc să automatizez mutarea celulelor fără a fi nevoie să deschid modulul și să apăs și pe F5. Ai rezolvat vreodată această întrebare? Vă mulțumesc anticipat!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Crystal a oferit informații despre cum să facă asta astăzi - aruncați o privire la prima pagină a acestui thread pentru a vedea răspunsul ei. Mută ​​automat rândul cu data de astăzi într-o coloană (L în cazul meu) într-o altă foaie de lucru.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Rulez acest cod și încerc să mut un rând pe baza datei de astăzi care apare în coloana I - Am schimbat Range("B1:B" & I) pentru a citi Range(I1:I" & I). Am schimbat " Terminat" în exemplul dvs. la Data. Cu toate acestea, atunci când data de astăzi apare oriunde în rând, nu doar în coloana I, după cum este necesar, rândul se mută în foaia de lucru alternativă. Orice idee de ce se întâmplă acest lucru și cum pot muta rândul numai când data de astăzi este în coloana I, indiferent dacă data de astăzi apare în alte coloane?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dacă aș vrea să am multe valori și multe foi în care să-mi muți rândul, ar trebui să scriu din nou întregul cod cu o valoare diferită pentru acea celulă? Adică, dacă pun NA într-o celulă, se duce la foaia Na, iar dacă pun W# se va duce la foaia cu numere greșită etc.
Acest comentariu a fost redus la minimum de moderatorul de pe site
salut, asta a fost de mare ajutor. Există vreo modalitate de a face acest lucru fără ca rândul de date să fie mutat pe a doua foaie, ci mai degrabă să fie copiat? Deci datele ar rămâne pe ambele foi?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, codul a fost foarte util, dar în loc să copiem întregul rând, am nevoie de o anumită selecție de rând pentru a fi mutată în foaia următoare. cum pot defini un interval în loc de un rând întreg Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J 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 I) În caz de eroare Reluați următoarea aplicație.ScreenUpdating = False pentru fiecare xCell din xRg Dacă CStr(xCell.Value) = „Done” Atunci xCell.Întregul rând.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1) J = J + 1 End If Next Application.ScreenUpdating = True End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
care ar fi codul dacă vreau să copiez rânduri (specifice celule) într-o altă foaie în anumite celule? DAR și pe baza unei valori Exemplu: șir de imagini color ale produsului white blender 2 whiteblender2 black juicer 3 blackjuicer3 red tv 1 redtv1 green iron 4 greeniron4 Aș dori ca șirul să fie copiat pe o altă foaie, dar numărul din coloana imagini arată de câte ori ar trebui copiat (deci, în acest caz, șirul blenderului trebuie copiat pe 2 rânduri
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, O bucată de cod foarte frumoasă, care funcționează foarte bine. Cum se schimbă acest cod pentru a muta rândurile dintr-un tabel în altul, în loc de o foaie în altă foaie? Mulţumesc mult !
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, încerc să folosesc codul, dar primesc o eroare de sintaxă pe Dim xCell As Range. Poti ajuta te rog?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Foi de lucru("Sheet1").UsedRange.Rows.Count J = Worksheets("Sheet2").UsedRange.Rows.Count If J = 1 Atunci dacă Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0 End If Set xRg = Worksheets("Sheet1").Range("C1:C" & I) On Error Resume Următoarea aplicație.ScreenUpdating = Fals pentru fiecare xCell din xRg Dacă CStr(xCell.Value) = „Done” Then xCell.EntireRow.Copy Destination:=Worksheets(„Sheet2”).Range(„A” & J + 1) xCell. EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub cum se poate adăuga o a doua foaie de lucru pentru a avea rândurile mutate în sheet2?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Ce ar trebui să introduc dacă vreau să includ orice dată ca valoare? Deci rândul rămâne pe foaia 1 dacă nu are dată și se mută pe foaia 2 dacă are?
Acest comentariu a fost redus la minimum de moderatorul de pe site
[citare] salut, asta a fost de mare ajutor. Există vreo modalitate de a face acest lucru fără ca rândul de date să fie mutat pe a doua foaie, ci mai degrabă să fie copiat? Deci datele ar rămâne pe ambele foi?De Maddie[/quote] a rezolvat cineva asta
Acest comentariu a fost redus la minimum de moderatorul de pe site
Eliminați acest „xCell.EntireRow.Delete” din cod
Acest comentariu a fost redus la minimum de moderatorul de pe site
Când șterg acea linie de cod și rulez macrocomanda din nou, Excel se blochează. De ce si cum il repar?? Vreau ca datele să fie pe ambele foi de lucru și să nu fie șterse din original. TIA
Acest comentariu a fost redus la minimum de moderatorul de pe site
exista un raspuns pentru asta? Și al meu se îngheață, aș dori să copiez, dar nu să șterg rândul
Acest comentariu a fost redus la minimum de moderatorul de pe site
O zi buna,
Codul VBA de mai jos vă poate ajuta să copiați doar rândurile în loc să le ștergeți.

Sub Cheezy()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Foi de lucru ("Sheet1").UsedRange.Rows.Count
J = Foi de lucru ("Sheet2").UsedRange.Rows.Count
Dacă J = 1, atunci
Dacă Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0, atunci J = 0
Final, dacă
Set xRg = Foi de lucru(„Sheet1”).Range(„C1:C” și I)
La data de eroare CV următoare
Application.ScreenUpdating = Fals
Pentru K = 1 To xRg.Count
Dacă CStr(xRg(K).Value) = „Terminat” Atunci
xRg(K).EntireRow.Copy Destination:=Foaie de lucru(„Sheet2”).Range(„A” și J + 1)
J = J + 1
Final, dacă
Pagina Următoare →
Application.ScreenUpdating = Adevărat
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, caut o variantă la asta. Am nevoie ca scriptul să ruleze continuu sau, în caz contrar, ori de câte ori valoarea din acel câmp specific se schimbă. Codul în sine funcționează, dar trebuie rulat independent. Aș vrea să fie automatizat. Poate cineva să ajute?

Deoparte, dacă vreau doar să copieze anumite celule din interval, cum se realizează asta?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă Rob,

Dacă aveți nevoie ca scriptul să ruleze automat când celulele din acel câmp s-au schimbat, codul VBA de mai jos vă poate ajuta. Faceți clic dreapta pe foaia curentă (foaia cu rânduri pe care o veți muta automat), apoi selectați Vizualizare cod din meniul contextual. Apoi copiați și inserați scriptul VBA de mai jos în fereastra Cod.

Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)

Dim xCell As Range

Dim I As Long
La data de eroare CV următoare

Application.ScreenUpdating = Fals

Set xCell = Target(1)
Dacă xCell.Value = „Terminat”, atunci
I = Foi de lucru ("Sheet2").UsedRange.Rows.Count
Dacă I ​​= 1 Atunci

Dacă Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0, atunci I = 0

Final, dacă

xCell.EntireRow.Copy Worksheets(„Sheet2”).Range(„A” și I + 1)

xCell.EntireRow.Delete
Final, dacă

Application.ScreenUpdating = Adevărat

End Sub


Pentru a doua întrebare, vrei să spui doar să copiați mai multe celule în loc de întregul rând? Sau vă rog să oferiți o captură de ecran a întrebării dvs.? Mulțumesc!

Cu stima, Crystal
Acest comentariu a fost redus la minimum de moderatorul de pe site
Cristal,


Ajutorul tău este mai mult decât nevoie :)



Cum putem adăuga un alt criteriu aici, de exemplu, aș dori să transfer Finalizat lângă Terminat:


Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)

Dim xCell As Range

Dim I As Long
La data de eroare CV următoare

Application.ScreenUpdating = Fals

Set xCell = Target(1)
Dacă xCell.Value = „Terminat”, atunci
I = Foi de lucru ("Sheet2").UsedRange.Rows.Count
Dacă I ​​= 1 Atunci

Dacă Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0, atunci I = 0

Final, dacă

xCell.EntireRow.Copy Worksheets(„Sheet2”).Range(„A” și I + 1)

xCell.EntireRow.Delete
Final, dacă

Application.ScreenUpdating = Adevărat

End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună Crystal
Acestea sunt cele mai utile informații pe care le-am găsit pe web și această macrocomandă face ceea ce vreau eu. Dar mut rândurile de la un tabel la altul - și cu această macrocomandă informațiile se mută pe prima linie liberă din afara tabelului, nu pe următoarea linie liberă din tabel? Poți să ajuți?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Rulez acest cod și încerc să mut un rând pe baza datei de astăzi care apare în coloana I - Am schimbat Range("B1:B" & I) pentru a citi Range(I1:I" & I) . Am schimbat " Terminat" în exemplul dvs. la Data. Cu toate acestea, atunci când data de astăzi apare oriunde în rând, nu doar în coloana I, după cum este necesar, rândul se mută în foaia de lucru alternativă. Orice idee de ce se întâmplă acest lucru și cum pot muta rândul numai când data de astăzi este în coloana I, indiferent dacă data de astăzi apare în alte coloane?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Draga David,

Codul funcționează bine pentru mine după ce am schimbat intervalul și valoarea variată până în prezent. Formatul de dată din codul dvs. trebuie să se potrivească cu formatul de dată pe care l-ați folosit în foaia de lucru. Sau este convenabil să atașați foaia de lucru?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut Crystal,


Nu sunt clar la ce te referi când spui că codul și formatele de date ale foii de calcul trebuie să se potrivească - nu sunt un expert VB, mai degrabă un nivel începător. În foaia mea de calcul introdu data de astăzi în coloana F ca dată de intrare a rândului, în formatul ctrl + :. Inscriu data de expirare in coloana "I" in formatul mm/zz/aaaa. Totuși, acest lucru cauzează probleme la efectuarea unei noi introduceri de rând și la introducerea datei de astăzi în coloana F, deoarece, de îndată ce este introdus, rândul este mutat în noua foaie de lucru. În plus, codul suplimentar de rulat ori de câte ori registrul de lucru este deschis nu apare. să alerg fără să o forțez să facă asta. Îmi pare rău pentru ceea ce ar putea fi pentru dvs. probleme foarte banale, dar pur și simplu nu reușesc să aud despre aceste probleme. Orice ajutor ar fi apreciat.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Draga David,

Am încercat exact ceea ce ați menționat mai sus, dar problema doza nu apare în cazul meu. Puteți furniza versiunea dvs. Excel? Am nevoie de mai multe informații pentru a ajuta la rezolvarea acestei probleme. Îmi pare rău că te deranjez din nou.

Cu stima, Crystal
Acest comentariu a fost redus la minimum de moderatorul de pe site
Crystal, acestea sunt foile de lucru în cauză. Veți vedea în codul copiat că caut „până la” data de astăzi în coloana L și dacă „până” și inclusiv data de azi este în acea coloană, atunci vreau să mut rândul care conține acea dată într-o nouă foaie de lucru. În prezent, când introduc data de astăzi oriunde în rând (de exemplu, coloana F dacă o solicitare este emisă astăzi), se mută automat întregul rând în foaia de calcul arhivată. De obicei, introdu data de astăzi folosind combinația ctrl + :, de obicei în coloana F.
În plus, aș dori ca această mișcare să se întâmple când deschid registrul de lucru. În prezent, trebuie să merg să arăt codul, apoi să apăs F5. Orice sfat despre cum să faci asta ar fi binevenit.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Din păcate, registrul meu de lucru cu macrocomandă nu se va încărca, deoarece scrie că formatul nu este acceptat. Acestea sunt în Excel 2016
Acest comentariu a fost redus la minimum de moderatorul de pe site
Draga David,

Următorul cod VBA vă poate ajuta să îl realizați.

Private Sub Workbook_Open()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
I = Foi de lucru ("CURRENT OASIS OPPORTUNITIES").UsedRange.Rows.Count
J = Foi de lucru(„OPPORTUNITĂȚI DE OAZĂ ARHIVATE”).UsedRange.Rows.Count
Dacă J = 1, atunci
Dacă Application.WorksheetFunction.CountA(Worksheets("OPPORTUNITĂȚI DE OAZĂ ARHIVATE").UsedRange) = 0 Atunci J = 0
Final, dacă
Set xRg = Worksheets(„CURRENT OASIS OPPORTUNITIES”).Range(„L1:L” & I)
La data de eroare CV următoare
Application.ScreenUpdating = Fals
Pentru fiecare xCell în xRg
Dacă CStr(xCell.Value) = Data Atunci
xCell.EntireRow.Copy Destination:=Foaie de lucru(„OPPORTUNITĂȚI DE OAZĂ ARHIVATE”).Range(„A” și J + 1)
xCell.EntireRow.Delete
J = J + 1
Final, dacă
Pagina Următoare →
End Sub

note:
1. Trebuie să puneți scriptul VBA în fereastra de cod ThisWorkbook;
2. Caietul de lucru trebuie să fie salvat ca registru de lucru Excel Macro-Enabled.

După operațiunea de mai sus, de fiecare dată când deschideți registrul de lucru, un rând întreg va fi mutat în foaia de lucru ARHIVED dacă celula din coloana L ajunge la data de astăzi.

Cu respect, Crystal
Acest comentariu a fost redus la minimum de moderatorul de pe site
Multumesc Crystal,
Acest lucru funcționează excelent dacă data de astăzi este atinsă în coloana L. Există vreo modalitate de a include până la data de astăzi și în coloana L, astfel încât, dacă nu verific registrul de lucru pentru un număr de zile, acesta va include automat date anterioare înainte de azi? Multumesc foarte mult pentru ajutorul tau.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Draga David,

Scuze, nu sunt sigur că am primit întrebarea ta. Dacă da, toate rândurile vor fi mutate atâta timp cât datele anterioare apar în coloana L?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut Crystal,

Dacă nu îmi deschid foaia de lucru timp de câteva zile și data introdusă în coloana L a trecut acum, adică data dintr-o celulă din coloana L este 11 septembrie 2017, dar nu îmi deschid foaia de lucru până pe 13 septembrie, aș ca toate intrările din coloana L să fie verificate pentru fiecare dată până la data de astăzi apoi mutați rândurile corespunzătoare în noua foaie. În prezent, cu codul pe care l-ați furnizat cu bunăvoință, numai rândurile cu data curentă în coloana L sunt mutate în noua foaie, lăsând în urmă cele cu o dată anterioară în coloana L, pe care în prezent le mutăm manual la noua foaie. Multumesc pentru ajutor.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Draga David,



Înțeleg punctul tău. Vă rugăm să încercați scriptul VBA de mai jos. Când deschideți registrul de lucru, toate rândurile cu date până la data de astăzi din coloana L vor fi mutate în noua foaie specificată.



Private Sub Workbook_Open()
Dim xRg As Range
Dim xRgRtn As Range
Dim xCell As Range
Dim xLastRow As Long
Dim I As Long
Dim J As Long
La data de eroare CV următoare
xLastRow = Foi de lucru(„CURRENT OASIS OPPORTUNITIES”).UsedRange.Rows.Count
Dacă xLastRow < 1, Ieșiți din sub
J = Foi de lucru(„OPPORTUNITĂȚI DE OAZĂ ARHIVATE”).UsedRange.Rows.Count
Dacă J = 1, atunci
Dacă Application.WorksheetFunction.CountA(Worksheets("OPPORTUNITĂȚI DE OAZĂ ARHIVATE").UsedRange) = 0 Atunci J = 0
Final, dacă
Set xRg = Foi de lucru(„CURRENT OASIS OPPORTUNITIES”).Range(„L1:L” & xLastRow)
Pentru I = 2 To xLastRow
Dacă xRg(I).Valoare > Data Apoi Ieșire Sub
Dacă xRg(I).Valoare <= Data Atunci
xRg(I).EntireRow.Copy Destination:=Foaie de lucru(„OPPORTUNITĂȚI DE OAZĂ ARHIVATE”).Range(„A” și J + 1)
xRg(I).EntireRow.Delete
J = J + 1
I = I - 1
Final, dacă
Pagina Următoare →
End Sub

Trebuie să puneți scriptul VBA în fereastra de cod ThisWorkbook și să salvați registrul de lucru ca un registru de lucru cu macrocomandă Excel.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Mulțumesc Crystal, funcționează bine.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Crystal, m-am grăbit să răspund că codul a funcționat. Mi-am deschis registrul de lucru astăzi, iar rândurile care conțin date anterioare în celula L din coloana sunt încă în „foaia de lucru actuală oportunități oază” și nu s-au mutat în „foaia de lucru oază arhivată” așa cum era de așteptat. Aveți vreo idee de ce ar fi așa?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Celulele evidențiate sunt în coloana L cu privire la întrebarea de mai sus și sunt criteriile (până la data de astăzi) pentru mutarea rândului în noua foaie de lucru. Sper că această imagine vă ajută.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Aceasta este, de asemenea, o copie a ferestrei VBA legate de cele de mai sus.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Crystal, m-am grăbit să răspund că codul a funcționat. Mi-am deschis registrul de lucru astăzi, iar rândurile care conțin date anterioare în celula L din coloana sunt încă în „foaia de lucru actuală oportunități oază” și nu s-au mutat în „foaia de lucru oază arhivată” așa cum era de așteptat. Aveți vreo idee de ce ar fi așa?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Cristal,

Deoarece nu îmi pot încărca registrul de lucru, voi reproduce rândurile și coloanele aici

ABCDEFGHIJKL
# Tip Solicitare Retragere Numărul de modificare Data emiterii Întrebări Client Locația de livrare Propunerea de proiect scadentă

1 SS SB 1234567 1 09/6/17 Fără Nume Armată Loc Conducere Tanc 09/10/17

Folosind codul de mai jos, vreau să mute un întreg rând într-o nouă foaie de lucru atunci când coloana L ajunge la data de astăzi. De asemenea, dacă nu am completat foaia de lucru de câteva zile, aș dori să folosească căutarea „până la data de astăzi” în coloana L pentru a face același lucru. De asemenea, aș dori să facă acest lucru automat când deschid registrul de lucru, dacă este posibil. În prezent, dacă introduc data de astăzi în orice celulă din rând, de exemplu coloana F când introduc date, întregul rând se mută în foaia de lucru arhivă. (Folosind Excel 2016)

[Codul Modulului 1]

Sub DaveV()

Dim xRg As Range

Dim xCell As Range

Dim I As Long

Dim J As Long

I = Foi de lucru ("CURRENT OASIS OPPORTUNITIES").UsedRange.Rows.Count

J = Foi de lucru(„OPPORTUNITĂȚI DE OAZĂ ARHIVATE”).UsedRange.Rows.Count

Dacă J = 1, atunci
Dacă Application.WorksheetFunction.CountA(Worksheets("OPPORTUNITĂȚI DE OAZĂ ARHIVATE").UsedRange) = 0 Atunci J = 0

Final, dacă

Set xRg = Worksheets(„CURRENT OASIS OPPORTUNITIES”).Range(„L1:L” & I)

La data de eroare CV următoare

Application.ScreenUpdating = Fals

Pentru fiecare xCell în xRg

Dacă CStr(xCell.Value) = Data Atunci

xCell.EntireRow.Copy Destination:=Foaie de lucru(„OPPORTUNITĂȚI DE OAZĂ ARHIVATE”).Range(„A” și J + 1)
xCell.EntireRow.Delete

J = J + 1
Final, dacă

Pagina Următoare →
Application.ScreenUpdating = Adevărat

End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
[Cod fișa 1]

Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
Dim xCell As Range
Dim I As Long
La data de eroare CV următoare
Application.ScreenUpdating = Fals
Set xCell = Target(1)
Dacă xCell.Value = Data Atunci
I = Fișe de lucru(„OPPORTUNITĂȚI DE OAZĂ ARHIVATE”).UsedRange.Rows.Count
Dacă I ​​= 1 Atunci
Dacă Application.WorksheetFunction.CountA(Worksheets("OPPORTUNITĂȚI DE OAZĂ ARHIVATE").UsedRange) = 0 Atunci I = 0 End If
xCell.EntireRow.Copy Worksheets(„OPPORTUNITĂȚI DE OAZĂ ARHIVATE”).Range(„A” și I + 1)
xCell.EntireRow.Delete
Final, dacă
Application.ScreenUpdating = Adevărat
End Sub

Sper că vă ajută cele de mai sus, dar nu sunt o persoană VBA, prin urmare, nu înțeleg cum să fac ca codul să facă ceea ce am nevoie. Ajutorul dumneavoastră ar fi apreciat.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Există o mare eroare în scriptul tău!

Să spunem că ați detectat că rândul 7 are cuvântul „Terminat” în coloana C, așa că îl copiați și ștergeți rândul.
Odată ce ați șters rândul, următorul rând din listă va fi rândul 9 și nu 8, deoarece odată eliminat a 7-a linie, acum conținutul celui de-al 8-lea rând este în rândul 7 și toate liniile au urcat cu 1 rând. Deci următorul rând de verificat trebuia să fie rândul #8, dar acum conține datele care erau anterior pe rândul #9, așa că de fiecare dată când ștergeți un rând, săriți peste un rând pentru a verifica!!!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă Shau Alon,

Multumesc pentru comentariu. Codul a fost actualizat cu eroarea remediată. Mulțumesc mult pentru asistentul tău.

Cu stima, Crystal
Acest comentariu a fost redus la minimum de moderatorul de pe site
Cred că mi se întâmplă asta, continuă să copieze același rând iar și iar, chiar dacă spune că codul a fost actualizat. Asta am:

Sub Cheezy()
„Actualizat de Kutools pentru 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 = Foi de lucru(„PURCHASE FORCAST”).UsedRange.Rows.Count
J = Foi de lucru(„Arhiva de achiziții”).UsedRange.Rows.Count
Dacă J = 1, atunci
Dacă Application.WorksheetFunction.CountA(Worksheets("Purchase Archive").UsedRange) = 0, atunci J = 0
Final, dacă
Set xRg = Foi de lucru(„PURCHASE FORCAST”).Range(„H3:H” și I)
La data de eroare CV următoare
Application.ScreenUpdating = Fals
Pentru K = 1 To xRg.Count
Dacă CStr(xRg(K).Value) = „Da”, atunci
xRg(K).EntireRow.Copy Destination:=Foaie de lucru(„Arhiva de achiziție”).Range(„A” și J + 1)
xRg(K).EntireRow.Delete
Dacă CStr(xRg(K).Value) = „Da”, atunci
K = K - 1
Final, dacă
J = J + 1
Final, dacă
Pagina Următoare →
Application.ScreenUpdating = Adevărat
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Hi Fred,
De fiecare dată când rulați codul, codul caută intervalul specificat, așa că copiază același rând iar și iar, deoarece nu poate spune ce rând a fost deja copiat. Pentru a evita copierea în mod repetat a aceluiași rând, puteți face ca codul să ruleze automat atunci când o valoare potrivită este introdusă în celula specificată.
În foaia de lucru numită „PURCHASE FORCAST”, faceți clic dreapta pe fila foii și faceți clic Afișați codul din meniul contextual. Apoi copiați următorul cod VBA în fereastra Sheet (Code).

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated by Kutools for Excel 20220830
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("PURCHASE FORCAST").UsedRange.Rows.Count
J = Worksheets("Purchase Archive").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Purchase Archive").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("PURCHASE FORCAST").Range("H3:H" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Yes" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Purchase Archive").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Yes" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
M-ar putea ajuta cineva să funcționeze? Am încercat să schimb piesa care trebuie să se potrivească cu fișierul meu, dar aceasta apare și nu sunt sigur ce să fac.
Acest comentariu a fost redus la minimum de moderatorul de pe site
scrie fișierul nu este acceptat când încerc să încarc fișierul excel. Îmi pare rău... mă lupt cu asta astăzi.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Aș dori ajutor pentru o sarcină similară, dar ușor diferită. Am 5 coloane de numere, în jur de 25000 pe coloană, fiecare coloană cu un titlu 1-5. Aș dori să copiez întregul rând pe o altă foaie dacă valoarea coloanei 1 este mai mare decât zero, SAU coloana 2 este mai mare decât zero , SAU coloana 3 este mai mică decât zero, SAU coloana 4 este mai mare decât cinci SAU coloana 5 este mai mare decât două etc. este posibil acest lucru?
Acest comentariu a fost redus la minimum de moderatorul de pe site
încărcarea imaginii nu funcționează... scuze.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Buna,
Vă rugăm să utilizați butonul de încărcare al acestuia.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Deci, scopul este de a vedea dacă vreunul dintre gaze depășește o limită pe care o voi stabili în formulă, întregul icre este COPIAT pe o foaie nouă.

Vă mulțumesc foarte mult pentru orice ajutor.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Imagine atașată
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă Michael,
Poate puteți rezolva această problemă folosind un program de completare Excel. Aici vă recomand utilitarul Selectați celule specifice din Kutools pentru Excel. Cu acest utilitar, puteți selecta cu ușurință toate rândurile dintr-un interval certian dacă valoarea unei coloane specificate este mai mare sau mai mică decât un număr. După ce ați selectat toate rândurile necesare, le puteți copia și lipi manual într-o nouă foaie de lucru. Vezi mai jos imaginea atașată.

Puteți afla mai multe despre această funcție urmând hyperlinkul de mai jos.
https://www.extendoffice.com/product/kutools-for-excel/excel-select-specific-cells-rows.html
Acest comentariu a fost redus la minimum de moderatorul de pe site
mulțumesc pentru această formulă, dar am avut o problemă care este când vreau să mut rândul pe o altă foaie, nu se întâmplă automat. imi poti da o alta formula? așa că ori de câte ori schimb valoarea celulei, aceasta se muta automat.


Mulțumiri
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă Janang,
Doza de cod nu se produce automat până când nu declanșați manual butonul de alergare.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună,

Aș dori să am această macrocomandă configurată, dar cu 2 argumente. Am reușit să fac macrocomanda să funcționeze în fișierul meu pe baza valorii celulelor din coloana O. Cu toate acestea, aș dori ca macrocomandă să verifice dacă și coloana S este completată (sau <> ""), înainte de a muta rândul . În cele din urmă, aș dori, de asemenea, ca rândurile copiate să aibă aceeași formatare ca și rândurile din a doua foaie. Asta schimbă complet macro-ul?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă Hugues,
Nu știu dacă te înțeleg corect. Vrei să spui că dacă celula din coloana S este completată și celula din coloana O conține o anumită valoare în același timp, atunci mutați rândul cu formatare? Altfel, nu te miști?
Acest comentariu a fost redus la minimum de moderatorul de pe site
salut cristal,

Da, exact asta vreau să spun. De fapt, datele mele sunt despre proiecte. Coloana mea O este starea proiectului meu, iar S data de încheiere a proiectului meu.
Vreau ca utilizatorii mei, persoanele care au informațiile și vor trebui să le introducă, să poată „Arhiva” un proiect NUMAI dacă au statutul de „Închis” și au introdus o „Data de încheiere”.


Sper că asta ajută la clarificarea lucrurilor
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă Hugues,
Scuze că răspund atât de târziu. Următorul cod VBA vă poate ajuta să rezolvați problema. Urmați pașii din acest articol pentru a aplica scriptul VBA.

Sub MoveRowBasedOnCellValue()
Dim xRgStatus As Range
Dim xRgDate ca interval
Dim I As Long
Dim J As Long
Dim K As Long
I = Foi de lucru ("Sheet1").UsedRange.Rows.Count
J = Foi de lucru ("Sheet2").UsedRange.Rows.Count
Dacă J = 1, atunci
Dacă Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0, atunci J = 0
Final, dacă
Set xRgStatus = Foi de lucru(„Sheet1”).Range(„O1:O” și I)
Set xRgDate = Foi de lucru(„Sheet1”).Range(„S1:S” și I)
La data de eroare CV următoare
Application.ScreenUpdating = Fals
Application.CutCopyMode = Fals
xRgStatus(1).EntireRow.Copy
Foi de lucru ("Sheet2").Range("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
Pentru K = 2 To xRgStatus.Count
Dacă CStr(xRgStatus(K).Value) = „Închis” atunci
Dacă (xRgDate(K).Value <> "") și (TypeName(xRgDate(K).Value) = "Data"), atunci
xRgStatus(K).EntireRow.Copy
Foi de lucru ("Sheet2").Range("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
Final, dacă
Final, dacă
Pagina Următoare →
Application.CutCopyMode = Adevărat
Application.ScreenUpdating = Adevărat
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă Crystal,

Vă mulțumesc foarte mult pentru ajutor!

Salutari,

Hugues
Acest comentariu a fost redus la minimum de moderatorul de pe site
Buna,


Cum copiez rândurile în loc să le mut?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Buna,


Știu că asta a fost postat de câteva ori, dar nu găsesc răspunsul. Cum pot copia materialul pe noua foaie și NU îl șterg din foaia originală?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă Mike,
Dacă doriți să copiați rândurile în loc să le ștergeți, codul VBA de mai jos vă poate ajuta. Multumesc pentru comentariu!

Sub Cheezy()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Foi de lucru ("Sheet1").UsedRange.Rows.Count
J = Foi de lucru ("Sheet2").UsedRange.Rows.Count
Dacă J = 1, atunci
Dacă Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0, atunci J = 0
Final, dacă
Set xRg = Foi de lucru(„Sheet1”).Range(„C1:C” și I)
La data de eroare CV următoare
Application.ScreenUpdating = Fals
Pentru K = 1 To xRg.Count
Dacă CStr(xRg(K).Value) = „Terminat” Atunci
xRg(K).EntireRow.Copy Destination:=Foaie de lucru(„Sheet2”).Range(„A” și J + 1)
J = J + 1
Final, dacă
Pagina Următoare →
Application.ScreenUpdating = Adevărat
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună,

Sunt nou în utilizarea macrocomenzilor, este posibil să lipiți datele de mai jos după o anumită valoare și se vor repeta până la sfârșitul coloanei?
Asa:

Transferați „Albastru” după „Culoare”

A1 = Albastru
A5= Culoare
A6= (transferă „Albastru” aici)
si asa mai departe...
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă John,
Vrei să spui că dacă o celulă conține „Culoare” într-o coloană, apoi copiați textul primei celule în celula de sub cea „Culoare” și repetați copiați acest text până la sfârșitul coloanei?
Nu există comentarii postate aici încă
Încărcați mai

Urmărește-ne

Copyright © 2009 - www.extendoffice.com. | Toate drepturile rezervate. Cu sprijinul ExtendOffice. | Harta site-ului
Microsoft și sigla Office sunt mărci comerciale sau mărci comerciale înregistrate ale Microsoft Corporation în Statele Unite și / sau în alte țări.
Protejat de Sectigo SSL