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

Hvordan flyttes hele rækken til et andet ark baseret på celleværdi i Excel?

For at flytte hele rækken til et andet ark baseret på celleværdi, hjælper denne artikel dig.

Flyt hele rækken til et andet ark baseret på celleværdi med VBA-kode
Flyt hele rækken til et andet ark baseret på celleværdi med Kutools til Excel

Flyt hele rækken til et andet ark baseret på celleværdi med VBA-kode

Som vist på nedenstående skærmbillede skal du flytte hele rækken fra Ark1 til Ark2, hvis der findes et specifikt ord "Udført" i kolonne C. Du kan prøve følgende VBA-kode.

1. Trykke andre+ F11 taster samtidigt for at åbne Microsoft Visual Basic til applikationer vindue.

2. Klik på i vinduet Microsoft Visual Basic til applikationer indsatte > Moduler. Kopier og indsæt derefter nedenstående VBA-kode i vinduet.

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

Bemærk: I koden, Sheet1 er regnearket indeholder den række, du vil flytte. Og Sheet2 er destinationsarket, hvor du finder rækken til. “C: C”Er kolonnen, der indeholder den bestemte værdi, og ordet“Udført”Er den bestemte værdi, du vil flytte række baseret på. Skift dem ud fra dine behov.

3. Tryk på F5 nøgle til at køre koden, så flyttes rækken, der opfylder kriterierne i Ark1, straks til Ark2.

Bemærk: Ovenstående VBA-kode sletter rækker fra de originale data efter at have flyttet til et specificeret regneark. Hvis du kun vil kopiere rækker baseret på celleværdi i stedet for at slette dem. Anvend nedenstående VBA-kode 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

Flyt hele rækken til et andet ark baseret på celleværdi med Kutools til Excel

Hvis du er nybegynder i VBA-kode. Her introducerer jeg Vælg specifikke celler nytte af Kutools til Excel. Med dette værktøj kan du nemt vælge alle rækker baseret på en bestemt celleværdi eller forskellige celleværdier i et regneark og kopiere de valgte rækker til destinationsarket efter behov. Gør som følger.

Før påføring Kutools til Excel, Bedes download og installer det først.

1. Vælg kolonnelisten, der indeholder den celleværdi, du vil flytte rækker baseret på, og klik derefter på Kutools > Type > Vælg specifikke celler. Se skærmbillede:

2. I åbningen Vælg specifikke celler dialogboksen, vælg Hele rækken i Valgtype sektion, vælg Lig i Specifik type på rullelisten, skal du indtaste celleværdien i tekstboksen og derefter klikke på OK .

En anden Vælg specifikke celler dialogboksen vises for at vise dig antallet af valgte rækker, og i mellemtiden indeholder alle rækker den angivne værdi i den valgte kolonne er valgt. Se skærmbillede:

3. Tryk på Ctrl + C nøgler til at kopiere de valgte rækker og derefter indsætte dem i det destinationsark, du har brug for.

Bemærk: Hvis du vil flytte rækker til et andet regneark baseret på to forskellige celleværdier. Flyt f.eks. Rækker baseret på celleværdier enten "Udført" eller "Behandling", du kan aktivere Or tilstand i Vælg specifikke celler dialogboks som vist nedenstående skærmbillede:

  Hvis du vil have en gratis prøveperiode (30-dag) for dette værktøj, klik for at downloade det, og gå derefter til at anvende handlingen i henhold til ovenstående trin.

Relaterede artikler:

De bedste Office-produktivitetsværktøjer

Kutools til Excel løser de fleste af dine problemer og øger din produktivitet med 80%

  • Genbruge: Indsæt hurtigt komplekse formler, diagrammer og alt, hvad du har brugt før; Krypter celler med adgangskode Opret postliste og send e-mails ...
  • Super formel bar (let redigere flere linjer med tekst og formel); Læsning Layout (let at læse og redigere et stort antal celler); Indsæt til filtreret rækkevidde...
  • Flet celler / rækker / kolonner uden at miste data; Split celler indhold; Kombiner duplikerede rækker / kolonner... Forhindre duplikerede celler; Sammenlign områder...
  • Vælg Duplicate eller Unique Rækker; Vælg tomme rækker (alle celler er tomme); Super Find og Fuzzy Find i mange arbejdsbøger; Tilfældig valg ...
  • Præcis kopi Flere celler uden at ændre formelreference; Auto Opret referencer til flere ark; Indsæt kugler, Afkrydsningsfelter og mere ...
  • Uddrag tekst, Tilføj tekst, Fjern efter position, Fjern mellemrum; Opret og udskriv personsøgningssubtotaler; Konverter mellem celler indhold og kommentarer...
  • Superfilter (gem og anvend filterskemaer på andre ark); Avanceret sortering efter måned / uge / dag, hyppighed og mere; Specielt filter af fed, kursiv ...
  • Kombiner arbejdsbøger og arbejdsark; Fletabeller baseret på nøglekolonner; Opdel data i flere ark; Batch Konverter xls, xlsx og PDF...
  • Mere end 300 kraftfulde funktioner. Understøtter Office / Excel 2007-2021 og 365. Understøtter alle sprog. Nem implementering i din virksomhed eller organisation. Fuld funktioner 30-dages gratis prøveperiode. 60 dages pengene tilbage garanti.
kte-fane 201905

Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere

  • Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
  • Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
  • Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!
officetab bund
Sorter kommentarer efter
Ældste først
Nyeste først
Kommentarer (299)
Ingen vurderinger endnu. Vær den første til at bedømme!
Ciaran
Ciaran
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, jeg fandt denne særlige guide virkelig nyttig i forhold til andre, jeg har set. Tak skal du have! Problemet, jeg har, er, at hvis jeg ændrer min ønskede værdi til 'Lukket', skal jeg køre F5 for at flytte rækken. Jeg vil gerne have, at den bevæger sig automatisk. Jeg er ny i Excel, så din hjælp er meget værdsat. Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Arbejdsark("ECR Incident Tracker").UsedRange.Rows.Count J = Arbejdsark("Løste problemer").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) Ved fejl Genoptag næste Application.ScreenUpdating = Falsk for hver xCell i xRg Hvis CStr(xCell.Value) = "Lukket" Så xCell.EntireRow.Copy Destination:=Worksheets("Løste problemer").Range("A" & J + 1) xCell.EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub
Svar
0
0
Talia
Talia     Ciaran
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, jeg forsøger at automatisere flytning af cellerne uden at skulle åbne modulet og trykke på F5 også. Har du nogensinde løst dette spørgsmål? Tak på forhånd!
Svar
0
0
David Vidler
David Vidler     Talia
Denne kommentar blev minimeret af moderatoren på webstedet
Crystal gav information om, hvordan man gør det i dag - kig på side et i denne tråd for at se hendes svar. Den flytter automatisk rækken med dagens dato i en kolonne (L i mit tilfælde) til et andet regneark.
Svar
Rapport
0
0
David
David     Ciaran
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg kører denne kode og forsøger at flytte en række baseret på dagens dato, der vises i kolonne I - Jeg har ændret Range("B1:B" & I) for at læse Range(I1:I" & I) . Jeg har ændret " Udført" i dit eksempel til dato. Men når dagens dato vises hvor som helst i rækken, ikke kun i I-kolonnen efter behov, flyttes rækken til det alternative regneark. Enhver idé om, hvorfor dette sker, og hvordan jeg kan få rækken til at flytte kun når dagens dato står i kolonne I, uanset om dagens dato står i andre kolonner?
Svar
0
0
Yoav
Yoav
Denne kommentar blev minimeret af moderatoren på webstedet
Hvis jeg ville have mange værdier og mange ark at flytte min række til, skulle jeg skrive hele koden igen med en anden værdi for den celle? Det betyder, at hvis jeg sætter NA i en celle, går det til Na-ark, og hvis jeg sætter W#, vil det gå til det forkerte talark osv.
Svar
0
0
Maddie
Maddie
Denne kommentar blev minimeret af moderatoren på webstedet
hej, dette var meget nyttigt. Er der en måde at gøre dette på uden at få rækken af ​​data flyttet til det andet ark, men snarere at få det kopieret? Så dataene ville forblive på begge ark?
Svar
0
0
bava
bava
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, koden var meget nyttig, men i stedet for at kopiere hele rækken kræver jeg, at et bestemt udvalg af række flyttes til næste ark. hvordan kan jeg definere et interval i stedet for en hel række 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(" Ark2").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) Ved fejl Genoptag næste ansøgning.ScreenUpdating = Falsk for hver xCell i xRg Hvis CStr(xCell.Value) = "Udført" Så xCell.Entire Row.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1) J = J + 1 End If Next Application.ScreenUpdating = True End Sub
Svar
0
0
Aafke Post
Aafke Post
Denne kommentar blev minimeret af moderatoren på webstedet
hvad ville koden være, hvis jeg vil kopiere rækker (specifikke celler) til et andet ark til bestemte celler? MEN også baseret på en værdi Eksempel: farve produkt billeder streng hvid blender 2 whiteblender2 sort juicer 3 blackjuicer3 rød tv 1 redtv1 grøn jern 4 greeniron4 Jeg vil gerne have strengen kopieret til et andet ark, men tallet i billedkolonnen fortæller hvor mange gange den skal kopieres (så i dette tilfælde blenderstrengen skal kopieres i 2 rækker
Svar
0
0
Prøvetager
Prøvetager
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, Meget flot stykke kode, fungerer meget godt. Hvordan ændres denne kode for at flytte rækker fra en tabel til en anden tabel i stedet for et ark til et andet ark? Mange tak !
Svar
0
0
Francesco
Francesco
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, jeg prøver at bruge koden, men jeg modtager en syntaksfejl på Dim xCell As Range. Kan du hjælpe venligst?
Svar
0
0
kay
kay
Denne kommentar blev minimeret af moderatoren på webstedet
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) Ved fejlgenoptagelse Næste Application.ScreenUpdating = Falsk for hver xCell i xRg Hvis CStr(xCell.Value) = "Udført" Så xCell.EntireRow.Copy Destination:=Worksheets("Ark2").Range("A" & J + 1) xCell. EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub, hvordan kan man tilføje et ekstra regneark for at få rækker flyttet til ark2?
Svar
0
0
Bethany Gordon
Bethany Gordon
Denne kommentar blev minimeret af moderatoren på webstedet
Hvad skal jeg indtaste, hvis jeg vil inkludere en dato som min værdi? Så rækken forbliver på ark 1, hvis den ikke har nogen dato, og flytter til ark 2, hvis den har?
Svar
0
0
sy
sy
Denne kommentar blev minimeret af moderatoren på webstedet
[quote]hej, dette var meget nyttigt. Er der en måde at gøre dette på uden at få rækken af ​​data flyttet til det andet ark, men snarere at få det kopieret? Så dataene ville forblive på begge ark?Af Maddie[/quote] har nogen løst dette
Svar
0
0
Jach
Jach     sy
Denne kommentar blev minimeret af moderatoren på webstedet
Fjern denne "xCell.EntireRow.Delete" fra koden
Svar
0
0
Bex
Bex     Jach
Denne kommentar blev minimeret af moderatoren på webstedet
Når jeg sletter den kodelinje og kører makroen igen, fryser Excel. Hvorfor og hvordan fikser jeg det?? Jeg ønsker, at dataene skal være på begge regneark og ikke slettes fra originalen. TIA
Svar
0
0
Kristel
Kristel     Bex
Denne kommentar blev minimeret af moderatoren på webstedet
er der et svar på dette? Min fryser også. Jeg vil gerne kopiere, men ikke slette rækken
Svar
0
0
krystal
krystal     Kristel
Denne kommentar blev minimeret af moderatoren på webstedet
Good Day,
Nedenstående VBA-kode kan hjælpe dig med kun at kopiere rækkerne i stedet for at slette dem.

Sub Cheezy()
Dim xRg As Range
Dim xCell As Range
Dim I Så længe
Dim J As Long
Dim K As Long
I = Arbejdsark("Ark1").UsedRange.Rows.Count
J = Arbejdsark("Ark2").UsedRange.Rows.Count
Hvis J = 1, så
Hvis Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Så J = 0
End If
Indstil xRg = Worksheets("Sheet1").Range("C1:C" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 Til xRg.Count
Hvis CStr(xRg(K).Value) = "Udført" Så
xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
J = J + 1
End If
Næste
Application.ScreenUpdating = True
End Sub
Svar
Rapport
0
0
Røve
Røve
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, jeg leder efter en variant af dette. Jeg har brug for, at scriptet kører kontinuerligt, eller fejler det, når værdien i det specifikke felt ændres. Selve koden fungerer, men skal køres uafhængigt. Jeg vil gerne have det automatiseret. Kan nogen hjælpe?

Som en sidebemærkning, hvis jeg kun vil have det til at kopiere over specifikke celler i området, hvordan opnås det så?
Svar
Rapport
0
0
krystal
krystal     Røve
Denne kommentar blev minimeret af moderatoren på webstedet
Kære Rob,

Hvis du har brug for, at scriptet kører automatisk, når cellerne i det felt ændres, kan nedenstående VBA-kode hjælpe dig. Højreklik på det aktuelle ark (arket med rækker, du vil flytte automatisk) fanen, og vælg derefter Vis kode i kontekstmenuen. Kopier og indsæt derefter nedenstående VBA-script i kodevinduet.

Privat Sub Worksheet_Change (ByVal Target As Range)

Dim xCell As Range

Dim I Så længe
On Error Resume Next

Application.ScreenUpdating = False

Indstil xCell = Target(1)
Hvis xCell.Value = "Udført" Så
I = Arbejdsark("Ark2").UsedRange.Rows.Count
Hvis jeg = 1, så

Hvis Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Så er I = 0

End If

xCell.EntireRow.Copy Worksheets("Sheet2").Range("A" & I + 1)

xCell.EntireRow.Delete
End If

Application.ScreenUpdating = True

End Sub


For dit andet spørgsmål, mener du bare kopiere flere celler i stedet for hele rækken? Eller vil du venligst give et skærmbillede af dit spørgsmål? Tak skal du have!

De bedste hilsner, Crystal
Svar
Rapport
0
0
MaryJ
MaryJ     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Krystal,


Din hjælp er mere end nødvendig :)



Hvordan vi kan tilføje et andet crtieria her, for eksempel vil jeg gerne overføre Fuldført ved siden af ​​Udført:


Privat Sub Worksheet_Change (ByVal Target As Range)

Dim xCell As Range

Dim I Så længe
On Error Resume Next

Application.ScreenUpdating = False

Indstil xCell = Target(1)
Hvis xCell.Value = "Udført" Så
I = Arbejdsark("Ark2").UsedRange.Rows.Count
Hvis jeg = 1, så

Hvis Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Så er I = 0

End If

xCell.EntireRow.Copy Worksheets("Sheet2").Range("A" & I + 1)

xCell.EntireRow.Delete
End If

Application.ScreenUpdating = True

End Sub
Svar
Rapport
0
0
Stusurrey
Stusurrey     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Crystal
Dette er den mest nyttige information, jeg har fundet på nettet, og denne makro gør, hvad jeg vil. Men jeg flytter rækkerne fra en tabel til en anden tabel - og med denne makro flytter informationen fra den første frie linje uden for tabellen, ikke den næste frie linje i tabellen? Kan du hjælpe?
Svar
0
0
David
David
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg kører denne kode og forsøger at flytte en række baseret på dagens dato, der vises i kolonne I - Jeg har ændret Range("B1:B" & I) for at læse Range(I1:I" & I) . Jeg har ændret " Udført" i dit eksempel til dato. Men når dagens dato vises hvor som helst i rækken, ikke kun i I-kolonnen efter behov, flyttes rækken til det alternative regneark. Enhver idé om, hvorfor dette sker, og hvordan jeg kan få rækken til at flytte kun når dagens dato står i kolonne I, uanset om dagens dato står i andre kolonner?
Svar
0
0
krystal
krystal     David
Denne kommentar blev minimeret af moderatoren på webstedet
Kære David,

Koden fungerer godt for mig efter at have ændret rækkevidden og variatværdien til dato. Datoformatet i din kode skal matche det datoformat, du brugte i regnearket. Eller er det praktisk for dig at vedhæfte dit arbejdsark?
Svar
Rapport
0
0
David Vidler
David Vidler     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Crystal,


Jeg er ikke klar over, hvad du mener, når du siger, at koden og regnearkets datoformater skal matche - jeg er ikke en VB-ekspert, mere et begynderniveau. I mit regneark indtaster jeg dagens dato i kolonne F som indtastningsdatoen for rækken, i formatet ctrl + :. Jeg indtaster udløbsdatoen i kolonne "I" i formatet mm/dd/åååå. Dette giver dog problemer, når du laver en ny rækkeindtastning og indtaster dagens dato i kolonne F, fordi rækken flyttes til det nye regneark, så snart den er indtastet. Derudover vises den ekstra kode, der skal køre, når projektmappen åbnes, ikke at løbe uden at jeg tvinger den til det. Beklager, hvad der kan være for dig meget trivielle problemer, men jeg kan bare ikke få min hørelse omkring disse problemer. Enhver hjælp ville blive værdsat.
Svar
Rapport
0
0
krystal
krystal     David Vidler
Denne kommentar blev minimeret af moderatoren på webstedet
Kære David,

Jeg har prøvet som præcis det, du nævnte ovenfor, men problemdosen vises ikke i mit tilfælde. Kan du levere din Excel-version? Jeg har brug for flere oplysninger for at hjælpe med at løse dette problem. Beklager at jeg forstyrrer dig igen.

De bedste hilsner, Crystal
Svar
Rapport
0
0
David Vidler
David Vidler     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Crystal, det er de pågældende arbejdsark. Du vil se i den kopierede kode, at jeg søger efter "op til " dags dato i kolonne L, og hvis "op til" og inklusive dags dato er i den kolonne, så vil jeg flytte rækken, der indeholder denne dato, til et nyt regneark. I øjeblikket, når jeg indtaster dagens dato hvor som helst i rækken (f.eks. kolonne F, hvis en opfordring udsendes i dag), flytter den automatisk hele rækken til det arkiverede regneark. Jeg indtaster normalt dagens dato ved at bruge ctrl + : kombinationen, normalt i kolonne F.
Derudover vil jeg gerne have, at dette træk sker, når jeg åbner projektmappen. I øjeblikket skal jeg gå for at vise kode og derefter trykke på F5. Ethvert råd om hvordan man gør det modtages gerne.
Svar
Rapport
0
0
David Vidler
David Vidler     David Vidler
Denne kommentar blev minimeret af moderatoren på webstedet
Desværre vil min makroaktiverede projektmappe ikke uploades, da den siger, at formatet ikke understøttes. Disse er i Excel 2016
Rapport
0
0
krystal
krystal     David Vidler
Denne kommentar blev minimeret af moderatoren på webstedet
Kære David,

Følgende VBA-kode kan hjælpe dig med at opnå det.

Privat underarbejdsbog_Åben()
Dim xRg As Range
Dim xCell As Range
Dim I Så længe
Dim J As Long
I = Arbejdsark("NUVÆRENDE OASISMULIGHEDER").UsedRange.Rows.Count
J = Arbejdsark("ARCHIVED OASIS OPPORTUNITITIES").UsedRange.Rows.Count
Hvis J = 1, så
Hvis Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITITIES").UsedRange) = 0 Så J = 0
End If
Indstil xRg = Arbejdsark("NUVÆRENDE OASISMULIGHEDER").Range("L1:L" & I)
On Error Resume Next
Application.ScreenUpdating = False
For hver xcelle i xRg
Hvis CStr(xCell.Value) = Dato Så
xCell.EntireRow.Copy Destination:=Worksheets("ARCHIVED OASIS OPPORTUNITITIES").Range("A" & J + 1)
xCell.EntireRow.Delete
J = J + 1
End If
Næste
End Sub

Bemærkninger:
1. Du skal indsætte VBA-scriptet i ThisWorkbook-kodevinduet;
2. Din projektmappe skal gemmes som Excel Macro-Enabled projektmappe.

Efter ovenstående handling, hver gang du åbner projektmappen, vil en hel række blive flyttet til ARKIVET regneark, hvis cellen i kolonne L når dagens dato.

Beast hilsen, Crystal
Rapport
0
0
David Vidler
David Vidler     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Tak Crystal,
Dette fungerer fint, hvis dagens dato er opnået i kolonne L. Er der nogen måde at inkludere op til dags dato i kolonne L også, så hvis jeg ikke tjekker projektmappen i et antal dage, vil den automatisk inkludere tidligere datoer før kl. dagens? Mange tak for din hjælp.
Rapport
0
0
krystal
krystal     David Vidler
Denne kommentar blev minimeret af moderatoren på webstedet
Kære David,

Beklager, jeg er ikke sikker på, at jeg har fået dit spørgsmål. Hvis ja, vil alle rækker blive flyttet, så længe tidligere datoer fremgår af kolonne L?
Rapport
0
0
David Vidler
David Vidler     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Crystal,

Hvis jeg ikke åbner mit arbejdsark i et par dage, og datoen i kolonne L nu er passeret, dvs. datoen i en celle i kolonne L er den 11. september 2017, men først åbner mit arbejdsark den 13. september, ville jeg ligesom alle poster i kolonne L, der skal kontrolleres for hver dato op til dags dato, så flyt de tilsvarende rækker til det nye ark. I øjeblikket med den kode, du elskværdigt har givet, flyttes kun rækker med den aktuelle dato i kolonne L til det nye ark, og efterlader dem med en tidligere dato i kolonne L, som jeg i øjeblikket flytter manuelt til det nye ark. Tak for din hjælp.
Rapport
0
0
krystal
krystal     David Vidler
Denne kommentar blev minimeret af moderatoren på webstedet
Kære David,



Jeg forstår din pointe. Prøv venligst nedenstående VBA-script. Når projektmappen åbnes, vil alle rækker med datoer op til dagens dato i kolonne L blive flyttet til et nyt specificeret ark.



Privat underarbejdsbog_Åben()
Dim xRg As Range
Dim xRgRtn As Range
Dim xCell As Range
Dim xLastRow As Long
Dim I Så længe
Dim J As Long
On Error Resume Next
xLastRow = Arbejdsark("CURRENT OASIS OPPORTUNITITIES").UsedRange.Rows.Count
Hvis xLastRow < 1 Afslut Sub
J = Arbejdsark("ARCHIVED OASIS OPPORTUNITITIES").UsedRange.Rows.Count
Hvis J = 1, så
Hvis Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITITIES").UsedRange) = 0 Så J = 0
End If
Indstil xRg = Arbejdsark("NUVÆRENDE OASISMULIGHEDER").Range("L1:L" & xLastRow)
For I = 2 Til xLastRow
Hvis xRg(I).Værdi > Dato Afslut Sub
Hvis xRg(I).Værdi <= Dato Så
xRg(I).EntireRow.Copy Destination:=Worksheets("ARCHIVED OASIS OPPORTUNITITIES").Range("A" & J + 1)
xRg(I).EntireRow.Delete
J = J + 1
I = I - 1
End If
Næste
End Sub

Du skal indsætte VBA-scriptet i ThisWorkbook-kodevinduet og gemme projektmappen som en Excel-makroaktiveret projektmappe.
Rapport
0
0
David Vidler
David Vidler     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Tak Crystal, det fungerer fint.
Rapport
0
0
David Vidler
David Vidler     David Vidler
Denne kommentar blev minimeret af moderatoren på webstedet
Crystal, jeg var lidt forhastet med at svare, at koden virkede. Jeg åbnede min projektmappe i dag, og rækker, der indeholder tidligere datoindtastninger i kolonne L-celle, er stadig i "aktuelle oasis-arbejdsark" og er ikke flyttet til "arkiveret oasis-regneark" som forventet. Nogle ideer til hvorfor dette ville være tilfældet?
Rapport
0
0
David Vidler
David Vidler     David Vidler
Denne kommentar blev minimeret af moderatoren på webstedet
De fremhævede celler er i kolonne L med hensyn til spørgsmålet ovenfor og er kriterierne (op til dags dato) for at flytte rækken til det nye regneark. Håber dette billede hjælper.
Rapport
0
0
David Vidler
David Vidler     David Vidler
Denne kommentar blev minimeret af moderatoren på webstedet
Dette er også en kopi af VBA-vinduet relateret til ovenstående.
Rapport
0
0
David Vidler
David Vidler     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Crystal, jeg var lidt forhastet med at svare, at koden virkede. Jeg åbnede min projektmappe i dag, og rækker, der indeholder tidligere datoindtastninger i kolonne L-celle, er stadig i "aktuelle oasis-arbejdsark" og er ikke flyttet til "arkiveret oasis-regneark" som forventet. Nogle ideer til hvorfor dette ville være tilfældet?
Rapport
0
0
David Vidler
David Vidler     David Vidler
Denne kommentar blev minimeret af moderatoren på webstedet
Krystal,

Da jeg ikke kan uploade min projektmappe, vil jeg gengive rækkerne og kolonnerne her

ABCDEFGHIJKL
# Type Tilsidesættelse Opfordring Ændr # Udstedelsesdato Spørgsmål Kunde leveringssted Projektforslag forfalder

1 SS SB 1234567 1 09/6/17 Nej Hærens navn Sted Drive Tank 09/10/17

Ved at bruge koden nedenfor vil jeg have den til at flytte en hel række til et nyt regneark, når kolonne L når dagens dato. Også hvis jeg ikke har udfyldt arbejdsarket i et antal dage, vil jeg gerne have, at det bruger "op til dags dato" søgning i kolonne L til at gøre det samme. Jeg vil også gerne have, at den gør dette automatisk, når jeg åbner projektmappen, hvis det er muligt. Hvis jeg i øjeblikket indtaster dagens dato i en celle i rækken, for eksempel kolonne F ved indtastning af data, flyttes hele rækken til arkivarket. (Bruger Excel 2016)

[Modul 1 kode]

Sub DaveV()

Dim xRg As Range

Dim xCell As Range

Dim I Så længe

Dim J As Long

I = Arbejdsark("NUVÆRENDE OASISMULIGHEDER").UsedRange.Rows.Count

J = Arbejdsark("ARCHIVED OASIS OPPORTUNITITIES").UsedRange.Rows.Count

Hvis J = 1, så
Hvis Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITITIES").UsedRange) = 0 Så J = 0

End If

Indstil xRg = Arbejdsark("NUVÆRENDE OASISMULIGHEDER").Range("L1:L" & I)

On Error Resume Next

Application.ScreenUpdating = False

For hver xcelle i xRg

Hvis CStr(xCell.Value) = Dato Så

xCell.EntireRow.Copy Destination:=Worksheets("ARCHIVED OASIS OPPORTUNITITIES").Range("A" & J + 1)
xCell.EntireRow.Delete

J = J + 1
End If

Næste
Application.ScreenUpdating = True

End Sub
Rapport
0
0
David Vidler
David Vidler     David Vidler
Denne kommentar blev minimeret af moderatoren på webstedet
[ark 1 kode]

Privat Sub Worksheet_Change (ByVal Target As Range)
Dim xCell As Range
Dim I Så længe
On Error Resume Next
Application.ScreenUpdating = False
Indstil xCell = Target(1)
Hvis xCell.Value = Dato derefter
I = Arbejdsark("ARCHIVED OASIS OPPORTUNITITIES").UsedRange.Rows.Count
Hvis jeg = 1, så
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITITIES").UsedRange) = 0 Så I = 0 End If
xCell.EntireRow.Copy Worksheets("ARCHIVED OASIS OPPORTUNITITIES").Range("A" & I + 1)
xCell.EntireRow.Delete
End If
Application.ScreenUpdating = True
End Sub

Håber ovenstående hjælper, men jeg er ikke en VBA person, derfor forstår jeg ikke hvordan man får koden til at gøre det jeg har brug for. Din hjælp ville blive værdsat.
Rapport
0
0
Shai Alon
Shai Alon
Denne kommentar blev minimeret af moderatoren på webstedet
Der er en stor fejl i dit script!

Sig, at du har opdaget, at række 7 har ordet "Udført" i kolonne C, så du kopierer det og sletter rækken.
Når du har slettet rækken, vil den næste række på listen være række 9 og ikke 8, for når du først fjernede 7. linje, er indholdet af 8. linje nu i linje 7, og alle linjerne gik 1 række op. Så den næste række at tjekke skulle være række #8, men nu indeholder den de data, der tidligere var på række #9, så hver gang du sletter en række, springer du faktisk en række over for at tjekke!!!
Svar
0
0
krystal
krystal     Shai Alon
Denne kommentar blev minimeret af moderatoren på webstedet
Kære Shau Alon,

Tak for din kommentar. Koden er blevet opdateret med fejlen rettet. Mange tak for din assistent.

De bedste hilsner, Crystal
Svar
Rapport
0
0
Fred
Fred     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg tror, ​​det sker for mig, den bliver ved med at kopiere den samme række igen og igen, selvom den siger, at koden blev opdateret. Dette er hvad jeg har:

Sub Cheezy()
'Opdateret af Kutools til Excel 2017/8/28
Dim xRg As Range
Dim xCell As Range
Dim I Så længe
Dim J As Long
Dim K As Long
I = Arbejdsark("PURCHASE FORCAST").UsedRange.Rows.Count
J = Arbejdsark("Købsarkiv").UsedRange.Rows.Count
Hvis J = 1, så
Hvis Application.WorksheetFunction.CountA(Worksheets("Purchase Archive").UsedRange) = 0 Så J = 0
End If
Set xRg = Worksheets("KØBSFORCAST").Range("H3:H" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 Til xRg.Count
Hvis CStr(xRg(K).Value) = "Ja" Så
xRg(K).EntireRow.Copy Destination:=Worksheets("Purchase Archive").Range("A" & J + 1)
xRg(K).EntireRow.Delete
Hvis CStr(xRg(K).Value) = "Ja" Så
K = K - 1
End If
J = J + 1
End If
Næste
Application.ScreenUpdating = True
End Sub
Svar
0
0
krystal
krystal     Fred
Denne kommentar blev minimeret af moderatoren på webstedet
Hej fred
Hver gang du kører koden, søger koden efter det angivne område, så den kopierer den samme række igen og igen, fordi den ikke kan se, hvilken række der allerede er blevet kopieret. For at undgå at kopiere den samme række gentagne gange, kan du få koden til at køre automatisk, når en matchende værdi indtastes i den angivne celle.
Højreklik på arkfanen i regnearket med navnet "KØB FORCAST", og klik Vis kode fra kontekstmenuen. Kopier derefter følgende VBA-kode i vinduet Ark (kode).

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
Svar
Rapport
0
0
Kylie Cole
Kylie Cole
Denne kommentar blev minimeret af moderatoren på webstedet
Kan nogen hjælpe mig med at få dette til at fungere? Jeg har forsøgt at ændre den del, der skal matche min fil, men dette kommer op, og jeg er ikke sikker på, hvad jeg skal gøre.
Svar
Rapport
0
0
Kylie Cole
Kylie Cole     Kylie Cole
Denne kommentar blev minimeret af moderatoren på webstedet
den siger, at filen ikke understøttes, når jeg prøver at uploade excel-filen. Undskyld... kæmper med det i dag.
Svar
Rapport
0
0
Michael Ghodsi
Michael Ghodsi
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg vil gerne have hjælp til en lignende opgave, men lidt anderledes. Jeg har 5 kolonner med tal, omkring 25000 pr. kolonne, hver kolonne med overskrift 1-5. Jeg vil gerne kopiere hele rækken til et andet ark, hvis værdien af ​​kolonne 1 er større end nul, ELLER kolonne 2 er større end nul , ELLER kolonne 3 er mindre end nul, ELLER kolonne 4 er større end fem ELLER kolonne 5 er større end to osv. er dette muligt?
Svar
Rapport
0
0
Michael Ghodsi
Michael Ghodsi     Michael Ghodsi
Denne kommentar blev minimeret af moderatoren på webstedet
billede upload virker ikke... beklager.
Svar
Rapport
0
0
Jay Chivo
Jay Chivo     Michael Ghodsi
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,
Brug venligst upload-knappen på denne.
Se vedhæftede filer (1 / 5)
Svar
Rapport
0
0
Michael Ghodsi
Michael Ghodsi     Jay Chivo
Denne kommentar blev minimeret af moderatoren på webstedet
Så målet er at se, om nogen af ​​gasserne er over en grænse, som jeg vil sætte i formlen, hele rognen kopieres over på et nyt ark.

Mange tak for enhver hjælp.
Svar
Rapport
0
0
Michael Ghodsi
Michael Ghodsi     Jay Chivo
Denne kommentar blev minimeret af moderatoren på webstedet
Billede vedhæftet
Se vedhæftede filer (1 / 5)
Svar
Rapport
0
0
krystal
krystal     Michael Ghodsi
Denne kommentar blev minimeret af moderatoren på webstedet
Kære Michael,
Måske kan du løse dette problem ved at bruge et Excel-tilføjelsesprogram. Her anbefaler jeg dig værktøjet Vælg specifikke celler i Kutools til Excel. Med dette værktøj kan du nemt vælge alle rækker i et bestemt område, hvis værdien af ​​en specificeret kolonne er større end eller mindre end et tal. Når du har valgt alle de nødvendige rækker, kan du manuelt kopiere og indsætte dem i et nyt regneark. Se nedenstående vedhæftede billede.

Du kan vide mere om denne funktion ved at følge nedenstående hyperlink.
https://www.extendoffice.com/product/kutools-for-excel/excel-select-specific-cells-rows.html
Se vedhæftede filer (1 / 5)
Svar
Rapport
0
0
janang
janang
Denne kommentar blev minimeret af moderatoren på webstedet
tak for denne formel, men jeg havde et problem, som er, at når jeg vil flytte rækken til et andet ark, sker det ikke automatisk. kan du give mig en anden formel? så når jeg ændrer værdien af ​​cellens, flyttede den sig automatisk.


tak
Svar
0
0
krystal
krystal     janang
Denne kommentar blev minimeret af moderatoren på webstedet
Kære janang,
Kodedoseringen sker ikke automatisk, før du aktiverer kørselsknappen manuelt.
Svar
Rapport
0
0
Hugues
Hugues
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,

Jeg vil gerne have denne makro sat op, men med 2 argumenter. Det lykkedes mig at få makroen til at fungere i min fil baseret på værdien af ​​cellerne i kolonne O. Jeg vil dog gerne have, at makroen tjekker, om kolonne S også er udfyldt (eller <> ""), før jeg flytter rækken . Til sidst vil jeg også gerne have, at de kopierede rækker har samme formatering som rækkerne i det andet ark. Ændrer det makroen fuldstændigt?
Svar
Rapport
0
0
krystal
krystal     Hugues
Denne kommentar blev minimeret af moderatoren på webstedet
Kære Hugues,
Jeg ved ikke, om jeg forstår dig på den rigtige måde. Du mener, at hvis celle i kolonne S er udfyldt og celle i kolonne O indeholder den bestemte værdi på samme tid, så flytte rækken med formatering? Ellers må du ikke bevæge dig?
Svar
Rapport
0
0
Hugues
Hugues     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Crystal,

Ja det er præcis det jeg mener. Faktisk handler mine data om projekter. Min kolonne O er status for mit projekt, og S slutdatoen for mit projekt.
Jeg ønsker, at mine brugere, de personer, der har oplysningerne og skal indsætte dem, KUN skal kunne "arkivere" et projekt, hvis de har deres status som "Lukket", og de har indsat en "Slutdato".


Jeg håber, at dette hjælper med at afklare tingene
Svar
0
0
krystal
krystal     Hugues
Denne kommentar blev minimeret af moderatoren på webstedet
Kære Hugues,
Undskyld jeg svarer så sent. Følgende VBA-kode kan hjælpe dig med at løse problemet. Følg trinene i denne artikel for at anvende VBA-scriptet.

Sub MoveRowBasedOnCellValue()
Dim xRgStatus As Range
Dim xRgDate Som område
Dim I Så længe
Dim J As Long
Dim K As Long
I = Arbejdsark("Ark1").UsedRange.Rows.Count
J = Arbejdsark("Ark2").UsedRange.Rows.Count
Hvis J = 1, så
Hvis Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Så J = 0
End If
Indstil xRgStatus = Worksheets("Sheet1").Range("O1:O" & I)
Indstil xRgDate = Worksheets("Sheet1"). Range("S1:S" & I)
On Error Resume Next
Application.ScreenUpdating = False
Application.CutCopyMode = False
xRgStatus(1).EntireRow.Copy
Arbejdsark("Ark2").Range("A" & J + 1).IndsætSpecial xlPasteAllUsingSourceTheme
J = J + 1
For K = 2 Til xRgStatus.Count
Hvis CStr(xRgStatus(K).Value) = "Lukket" Så
Hvis (xRgDate(K).Value <> "") Og (TypeName(xRgDate(K).Value) = "Dato") Så
xRgStatus(K).EntireRow.Copy
Arbejdsark("Ark2").Range("A" & J + 1).IndsætSpecial xlPasteAllUsingSourceTheme
J = J + 1
End If
End If
Næste
Application.CutCopyMode = Sand
Application.ScreenUpdating = True
End Sub
Svar
Rapport
0
0
Hugues
Hugues     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Kære Crystal,

Tak så meget for din hjælp!

Hilsen,

Hugues
Svar
0
0
Mike
Mike
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,


Hvordan kopierer jeg rækkerne i stedet for at flytte dem?
Svar
0
0
Mike Preston
Mike Preston
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,


Jeg ved, at dette er blevet postet et par gange, men jeg kan ikke finde svaret. Hvordan kan jeg kopiere materialet til det nye ark og IKKE slette det fra det originale ark?
Svar
Rapport
0
0
krystal
krystal     Mike Preston
Denne kommentar blev minimeret af moderatoren på webstedet
Kære Mike,
Hvis du vil kopiere rækkerne i stedet for at slette dem, kan nedenstående VBA-kode hjælpe dig. Tak for din kommentar!

Sub Cheezy()
Dim xRg As Range
Dim xCell As Range
Dim I Så længe
Dim J As Long
Dim K As Long
I = Arbejdsark("Ark1").UsedRange.Rows.Count
J = Arbejdsark("Ark2").UsedRange.Rows.Count
Hvis J = 1, så
Hvis Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Så J = 0
End If
Indstil xRg = Worksheets("Sheet1").Range("C1:C" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 Til xRg.Count
Hvis CStr(xRg(K).Value) = "Udført" Så
xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
J = J + 1
End If
Næste
Application.ScreenUpdating = True
End Sub
Svar
Rapport
0
0
John Carlo
John Carlo
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,

Jeg er ny til at bruge makroer, er det muligt at indsætte dataene nedenfor efter en bestemt værdi og vil blive gentaget indtil slutningen af ​​kolonnen?
Sådan her:

Overfør "Blå" efter "Farve"

A1 = Blå
A5= Farve
A6= (overfør "Blå" her)
og så videre...
Svar
0
0
krystal
krystal     John Carlo
Denne kommentar blev minimeret af moderatoren på webstedet
Kære John,
Mener du, at hvis en celle indeholder "Farve" i en kolonne, så kopier teksten fra den første celle til cellen under "Farve" og gentag kopiere denne tekst indtil slutningen af ​​kolonnen?
Svar
Rapport
0
0
Der er endnu ingen kommentarer her
Load More
Efterlad dine kommentarer
Gæst
Sender som gæst
Login
×
Bedøm dette indlæg:
Nulstil
0   Tegn
Foreslåede steder

Følg os

Copyright © 2009 - www.extendoffice.com. | Alle rettigheder forbeholdes. Drevet af ExtendOffice. | | Sitemap
Microsoft og Office-logoet er varemærker eller registrerede varemærker tilhørende Microsoft Corporation i USA og / eller andre lande.
Beskyttet af Sectigo SSL