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

Hur flyttar jag hela raden till ett annat ark baserat på cellvärde i Excel?

För att flytta hela raden till ett annat ark baserat på cellvärde hjälper den här artikeln dig.

Flytta hela raden till ett annat ark baserat på cellvärde med VBA-kod
Flytta hela raden till ett annat ark baserat på cellvärde med Kutools för Excel


Flytta hela raden till ett annat ark baserat på cellvärde med VBA-kod

Som bilden nedan visas måste du flytta hela raden från Sheet1 till Sheet2 om det finns ett specifikt ord "Klar" i kolumn C. Du kan prova följande VBA-kod.

1. Tryck andra+ F11 samtidigt för att öppna Microsoft Visual Basic för applikationer fönster.

2. Klicka på i fönstret Microsoft Visual Basic for Applications Insert > Modulerna. Kopiera sedan och klistra in nedanstående VBA-kod i fönstret.

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

Anmärkningar: I koden, Sheet1 är kalkylbladet innehåller raden du vill flytta. Och Sheet2 är destinationens kalkylblad där du hittar raden till. “C: C”Är kolumnen innehåller ett visst värde och ordet”Färdig ”Är det bestämda värdet du kommer att flytta rad baserat på. Ändra dem baserat på dina behov.

3. tryck på F5 för att köra koden, sedan flyttas raden som uppfyller kriterierna i Sheet1 till Sheet2 omedelbart.

Anmärkningar: Ovanstående VBA-kod tar bort rader från originaldata efter att ha flyttat till ett angivet kalkylblad. Om du bara vill kopiera rader baserat på cellvärde istället för att radera dem. Använd nedanstående VBA-kod 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

Flytta hela raden till ett annat ark baserat på cellvärde med Kutools för Excel

Om du är nybörjare i VBA-kod. Här presenterar jag Välj specifika celler nytta av Kutools för Excel. Med det här verktyget kan du enkelt välja alla rader baserat på ett visst cellvärde eller olika cellvärden i ett kalkylblad och kopiera de markerade raderna till målkalkylbladet efter behov. Gör så här.

Innan du ansöker Kutools för ExcelBer ladda ner och installera det först.

1. Välj kolumnlistan som innehåller cellvärdet du ska flytta rader baserat på och klicka sedan på Kutools > Välja > Välj specifika celler. Se skärmdump:

2. I öppningen Välj specifika celler dialogrutan, välj Hela raden i Urvalstyp avsnitt, välj lika i Specifik typ rullgardinsmenyn, ange cellvärdet i textrutan och klicka sedan på OK knapp.

Annan Välj specifika celler dialogrutan dyker upp för att visa antalet valda rader, och under tiden innehåller alla rader det angivna värdet i vald kolumn har valts. Se skärmdump:

3. tryck på ctrl + C för att kopiera de markerade raderna och klistra in dem i det målkalkylblad du behöver.

Anmärkningar: Om du vill flytta rader till ett annat kalkylblad baserat på två olika cellvärden. Till exempel, flytta rader baserat på cellvärden antingen "Klar" eller "Bearbetning", du kan aktivera Or tillstånd i Välj specifika celler dialogruta som visas nedan:

  Om du vill ha en gratis provperiod (30-dag) för detta verktyg, klicka för att ladda ner den, och gå sedan till för att tillämpa operationen enligt ovanstående steg.


Relaterade artiklar:


De bästa Office-produktivitetsverktygen

Kutools för Excel löser de flesta av dina problem och ökar din produktivitet med 80%

  • återanvändning: Sätt snabbt i komplexa formler, diagram och allt som du har använt tidigare; Kryptera celler med lösenord; Skapa e-postlista och skicka e-post ...
  • Super Formula Bar (enkelt redigera flera rader med text och formel); Läslayout (enkelt läsa och redigera ett stort antal celler); Klistra in i filtrerat intervall...
  • Sammanfoga celler / rader / kolumner utan att förlora data; Delat cellinnehåll; Kombinera duplicerade rader / kolumner... Förhindra duplicerade celler; Jämför intervall...
  • Välj Duplicera eller Unikt Rader; Välj tomma rader (alla celler är tomma); Super Find och Fuzzy Find i många arbetsböcker; Slumpmässigt val ...
  • Exakt kopia Flera celler utan att ändra formelreferens; Skapa referenser automatiskt till flera ark; Sätt in kulor, Kryssrutor och mer ...
  • Extrahera text, Lägg till text, ta bort efter position, Ta bort mellanslag; Skapa och skriva ut personsökningstalsatser; Konvertera mellan celler innehåll och kommentarer...
  • Superfilter (spara och tillämpa filterscheman på andra ark); Avancerad sortering efter månad / vecka / dag, frekvens och mer; Specialfilter av fet, kursiv ...
  • Kombinera arbetsböcker och arbetsblad; Sammanfoga tabeller baserat på nyckelkolumner; Dela data i flera ark; Batchkonvertera xls, xlsx och PDF...
  • Mer än 300 kraftfulla funktioner. Stöder Office / Excel 2007-2021 och 365. Stöder alla språk. Enkel implementering i ditt företag eller organisation. Fullständiga funktioner 30 dagars gratis provperiod. 60 dagars pengarna tillbaka-garanti.
kte-flik 201905

Fliken Office ger ett flikgränssnitt till Office och gör ditt arbete mycket enklare

  • Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
  • Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
  • Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje dag!
officetab botten
Sortera kommentarer efter
Kommentarer (299)
Inga betyg än. Bli först med att betygsätta!
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, jag tyckte att den här guiden var mycket användbar framför andra jag har sett. Tack! Problemet jag har är att om jag ändrar mitt önskade värde till 'Stängd' måste jag köra F5 för att flytta raden. Jag vill att den ska flyttas automatiskt. Jag är ny på Excel så din hjälp är mycket uppskattad. Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Worksheets("ECR Incident Tracker").UsedRange.Rows.Count J = Worksheets("Resolved Issues").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) Vid fel Återuppta nästa ansökan.ScreenUpdating = Falskt för varje xCell i xRg Om CStr(xCell.Value) = "Stängd" Sedan xCell.EntireRow.Copy Destination:=Worksheets("Lösa problem").Range("A" & J + 1) xCell.EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, jag försöker automatisera att flytta över cellerna utan att behöva öppna modulen och trycka på F5 också. Har du någonsin löst den här frågan? Tack på förhand!
Denna kommentar minimerades av moderatoren på webbplatsen
Crystal gav information om hur man gör det idag - ta en titt på sida ett i den här tråden för att se hennes svar. Den flyttar automatiskt raden med dagens datum i en kolumn (L i mitt fall) till ett annat kalkylblad.
Denna kommentar minimerades av moderatoren på webbplatsen
Jag kör den här koden och försöker flytta en rad baserat på dagens datum som visas i kolumn I - Jag har ändrat Range("B1:B" & I) för att läsa Range(I1:I" & I) . Jag har ändrat " Klar" i ditt exempel till Date. Men när dagens datum visas var som helst i raden, inte bara i kolumnen I efter behov, flyttas raden till det alternativa kalkylbladet. Någon idé om varför detta händer och hur jag kan få raden att flytta endast när dagens datum står i kolumn I, oavsett om dagens datum står i andra kolumner?
Denna kommentar minimerades av moderatoren på webbplatsen
Om jag ville ha många värden och många ark att flytta min rad till, skulle jag behöva skriva hela koden igen med ett annat värde för den cellen? Det betyder, om jag lägger NA i en cell går det till Na-ark, och om jag sätter W# kommer det att gå till fel nummerblad etc.
Denna kommentar minimerades av moderatoren på webbplatsen
hej, detta var till stor hjälp. Finns det något sätt att göra detta utan att raden med data flyttas till det andra arket, utan snarare att få det kopierat? Så data skulle finnas kvar på båda arken?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej koden var till stor hjälp, men istället för att kopiera hela raden kräver jag att ett visst urval av rader flyttas till nästa ark. hur kan jag definiera ett intervall istället för en hel rad 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) Vid fel Återuppta nästa applikation.ScreenUpdating = Falskt för varje xCell i xRg Om CStr(xCell.Value) = "Klar" Sedan xCell.Hela raden.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1) J = J + 1 End If Next Application.ScreenUpdating = True End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
vad skulle vara koden om jag vill kopiera rader (specifika celler) till ett annat ark till specifika celler? MEN också baserat på ett värde Exempel: färg produktbilder sträng vit mixer 2 whiteblender2 svart juicepress 3 blackjuicer3 röd tv 1 redtv1 grön järn 4 greeniron4 Jag skulle vilja att strängen kopieras till ett annat ark men siffran i bildkolumnen talar om hur många gånger den ska kopieras (så, i det här fallet, mixersträngen ska kopieras i 2 rader
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, Mycket trevlig kod som fungerar mycket bra. Hur ändrar man den här koden för att flytta rader från en tabell till en annan tabell, istället för ett ark till ett annat ark? Tack så mycket !
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Jag försöker använda koden men jag får ett syntaxfel på Dim xCell As Range. Kan du hjälpa snälla?
Denna kommentar minimerades av moderatoren på webbplatsen
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) Vid Fel Återuppta Next Application.ScreenUpdating = Falskt för varje xCell In xRg If CStr(xCell.Value) = "Klart" Sedan xCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1) xCell. EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub hur kan man lägga till ett andra kalkylblad för att få rader att flytta till ark2?
Denna kommentar minimerades av moderatoren på webbplatsen
Vad ska jag ange om jag vill inkludera ett datum som mitt värde? Så raden stannar på blad 1 om den inte har något datum, och flyttas till blad 2 om den har det?
Denna kommentar minimerades av moderatoren på webbplatsen
[quote]hej, det här var till stor hjälp. Finns det något sätt att göra detta utan att raden med data flyttas till det andra arket, utan snarare att få det kopierat? Så data skulle finnas kvar på båda arken?Av Maddie[/quote] har någon löst detta
Denna kommentar minimerades av moderatoren på webbplatsen
Ta bort denna "xCell.EntireRow.Delete" från koden
Denna kommentar minimerades av moderatoren på webbplatsen
När jag tar bort den kodraden och kör makrot igen, fryser Excel. Varför och hur fixar jag det?? Jag vill att data ska finnas på båda kalkylbladen och inte raderas från originalet. TIA
Denna kommentar minimerades av moderatoren på webbplatsen
finns det ett svar på detta? Min fryser också. Jag skulle vilja kopiera men inte ta bort raden
Denna kommentar minimerades av moderatoren på webbplatsen
God dag,
VBA-koden nedan kan hjälpa dig att bara kopiera raderna istället för att ta bort dem.

Sub Cheezy()
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
Om J = 1 då
Om Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Då J = 0
End If
Set xRg = Worksheets("Sheet1"). Range("C1:C" & I)
On Error Resume Next
Application.ScreenUpdating = False
För K = 1 Till xRg.Count
Om CStr(xRg(K).Value) = "Klar" Då
xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
J = J + 1
End If
Nästa
Application.ScreenUpdating = True
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, jag letar efter en variant på detta. Jag behöver skriptet för att köra kontinuerligt, eller misslyckas det när värdet i det specifika fältet ändras. Själva koden fungerar men måste köras oberoende. Jag vill att det ska vara automatiserat. Kan någon hjälpa?

För övrigt, om jag bara vill att det ska kopieras över specifika celler i intervallet, hur åstadkoms det?
Denna kommentar minimerades av moderatoren på webbplatsen
Kära Rob,

Om du behöver att skriptet ska köras automatiskt när cellerna i det fältet ändras, kan nedanstående VBA-kod hjälpa dig. Högerklicka på det aktuella arket (arket med rader som du flyttar automatiskt) och välj sedan Visa kod från snabbmenyn. Kopiera sedan och klistra in nedanstående VBA-skript i kodfönstret.

Privata delarkivsförändring (ByVal-mål som område)

Dim xCell As Range

Dim I As Long
On Error Resume Next

Application.ScreenUpdating = False

Ställ in xCell = Target(1)
Om xCell.Value = "Klart" Då
I = Worksheets("Sheet2").UsedRange.Rows.Count
Om jag = 1 då

Om Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Då I = 0

End If

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

xCell.EntireRow.Delete
End If

Application.ScreenUpdating = True

End Sub


För din andra fråga, menar du bara kopiera flera celler istället för hela raden? Eller vill du ge en skärmdump av din fråga? Tack!

Med vänlig hälsning, Crystal
Denna kommentar minimerades av moderatoren på webbplatsen
Kristall,


Din hjälp är mer än vad som behövs :)



Hur vi kan lägga till ytterligare ett kriterium här, till exempel skulle jag vilja överföra Slutfört bredvid Klar:


Privata delarkivsförändring (ByVal-mål som område)

Dim xCell As Range

Dim I As Long
On Error Resume Next

Application.ScreenUpdating = False

Ställ in xCell = Target(1)
Om xCell.Value = "Klart" Då
I = Worksheets("Sheet2").UsedRange.Rows.Count
Om jag = 1 då

Om Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Då I = 0

End If

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

xCell.EntireRow.Delete
End If

Application.ScreenUpdating = True

End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Crystal
Det här är den mest användbara informationen jag har hittat på webben och det här makrot gör vad jag vill. Men jag flyttar raderna från en tabell till en annan tabell - och med detta makro flyttas informationen från den första fria raden utanför tabellen, inte nästa fria rad i tabellen? Kan du hjälpa?
Denna kommentar minimerades av moderatoren på webbplatsen
Jag kör den här koden och försöker flytta en rad baserat på dagens datum som visas i kolumn I - Jag har ändrat Range("B1:B" & I) för att läsa Range(I1:I" & I) . Jag har ändrat " Klar" i ditt exempel till Date. Men när dagens datum visas var som helst i raden, inte bara i kolumnen I efter behov, flyttas raden till det alternativa kalkylbladet. Någon idé om varför detta händer och hur jag kan få raden att flytta endast när dagens datum står i kolumn I, oavsett om dagens datum står i andra kolumner?
Denna kommentar minimerades av moderatoren på webbplatsen
Kära David,

Koden fungerar bra för mig efter att ha ändrat intervallet och variatvärdet hittills. Datumformatet i din kod måste matcha datumformatet du använde i kalkylbladet. Eller är det bekvämt för dig att bifoga ditt arbetsblad?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Crystal,


Jag är inte klar över vad du menar när du säger att koden och kalkylbladets datumformat måste matcha - jag är ingen VB-expert, snarare en nybörjarnivå. I mitt kalkylblad anger jag dagens datum i kolumn F som inmatningsdatum för raden, i formatet ctrl + :. Jag anger utgångsdatumet i kolumn "I" i formatet mm/dd/åååå. Detta orsakar dock problem när man gör en ny radinmatning och anger dagens datum i kolumn F eftersom raden flyttas till det nya kalkylbladet så snart det matas in. Dessutom visas inte tilläggskoden som ska köras när arbetsboken öppnas. att springa utan att jag tvingar den till det. Ursäkta för vad som kan vara väldigt triviala problem för dig men jag kan bara inte höra mig kring dessa problem. All hjälp skulle uppskattas.
Denna kommentar minimerades av moderatoren på webbplatsen
Kära David,

Jag har försökt precis som du nämnde ovan, men problemdosen visas inte i mitt fall. Kan du tillhandahålla din Excel-version? Jag behöver mer information för att lösa det här problemet. Ledsen att jag besvärar dig igen.

Med vänlig hälsning, Crystal
Denna kommentar minimerades av moderatoren på webbplatsen
Crystal, det här är de berörda arbetsbladen. Du kommer att se i den kopierade koden att jag söker efter "upp till " dagens datum i kolumn L och om "upp till" och inklusive dagens datum finns i den kolumnen så vill jag flytta raden som innehåller det datumet till ett nytt kalkylblad. För närvarande, när jag anger dagens datum var som helst på raden (till exempel kolumn F om en uppmaning utfärdas idag) flyttas hela raden automatiskt till det arkiverade kalkylarket. Jag anger vanligtvis dagens datum genom att använda kombinationen ctrl + :, vanligtvis i kolumn F.
Dessutom skulle jag vilja att denna åtgärd ska ske när jag öppnar arbetsboken. För närvarande måste jag gå för att visa koden och tryck sedan på F5. Alla råd om hur man gör det tas tacksamt emot.
Denna kommentar minimerades av moderatoren på webbplatsen
Tyvärr kommer min makroaktiverade arbetsbok inte att laddas upp eftersom det står att formatet inte stöds. Dessa finns i Excel 2016
Denna kommentar minimerades av moderatoren på webbplatsen
Kära David,

Följande VBA-kod kan hjälpa dig att uppnå det.

Privat Sub Workbook_Open ()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
I = Worksheets("CURRENT OASIS OPPORTUNITITIES").UsedRange.Rows.Count
J = Arbetsblad("ARCHIVED OASIS OPPORTUNITITIES").UsedRange.Rows.Count
Om J = 1 då
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITITIES").UsedRange) = 0 Då J = 0
End If
Set xRg = Worksheets("CURRENT OASIS OPPORTUNITITIES").Range("L1:L" & I)
On Error Resume Next
Application.ScreenUpdating = False
För varje xCell In xRg
Om CStr(xCell.Value) = Datum då
xCell.EntireRow.Copy Destination:=Worksheets("ARCHIVED OASIS OPPORTUNITITIES").Range("A" & J + 1)
xCell.EntireRow.Delete
J = J + 1
End If
Nästa
End Sub

Anmärkningar:
1. Du måste lägga in VBA-skriptet i ThisWorkbook-kodfönstret;
2. Din arbetsbok måste sparas som Excel Macro-Enabled Workbook.

Efter ovanstående operation, varje gång du öppnar arbetsboken, kommer en hel rad att flyttas till ARKIVAT kalkylblad om cellen i kolumn L når dagens datum.

Hälsningar, Crystal
Denna kommentar minimerades av moderatoren på webbplatsen
Tack Crystal,
Detta fungerar utmärkt om dagens datum uppnås i kolumn L. Finns det något sätt att inkludera fram till dagens datum i kolumn L också, så att om jag inte kollar arbetsboken under ett antal dagar kommer den automatiskt att inkludera tidigare datum före kl. dagens? Tack så mycket för din hjälp.
Denna kommentar minimerades av moderatoren på webbplatsen
Kära David,

Förlåt, jag är inte säker på att jag fick din fråga. Om så är fallet kommer alla rader att flyttas så länge som tidigare datum finns i kolumn L?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Crystal,

Om jag inte öppnar mitt kalkylblad på några dagar och datumet i kolumn L nu har passerat, dvs datumet i en cell i kolumn L är 11 september 2017 men öppnar inte mitt kalkylblad förrän 13 september, skulle jag som alla poster i kolumn L som ska kontrolleras för varje datum fram till dagens datum, flytta sedan motsvarande rader till det nya arket. För närvarande med koden som du tacksamt angav, flyttas bara rader med aktuellt datum i kolumn L till det nya bladet och lämnar efter sig de med ett tidigare datum i kolumn L, som jag för närvarande flyttar manuellt till det nya bladet. Tack för hjälpen.
Denna kommentar minimerades av moderatoren på webbplatsen
Kära David,



Jag förstår din poäng. Vänligen prova nedanstående VBA-skript. När du öppnar arbetsboken kommer alla rader med datum fram till dagens datum i kolumn L att flyttas till ett nytt specificerat ark.



Privat Sub Workbook_Open ()
Dim xRg As Range
Dim xRgRtn As Range
Dim xCell As Range
Dim xLast Row As Long
Dim I As Long
Dim J As Long
On Error Resume Next
xLastRow = Worksheets("CURRENT OASIS OPPORTUNITITIES").UsedRange.Rows.Count
Om xLastRow < 1 Avsluta Sub
J = Arbetsblad("ARCHIVED OASIS OPPORTUNITITIES").UsedRange.Rows.Count
Om J = 1 då
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITITIES").UsedRange) = 0 Då J = 0
End If
Set xRg = Worksheets("CURRENT OASIS OPPORTUNITITIES").Range("L1:L" & xLastRow)
För I = 2 Till xLastRow
Om xRg(I).Value > Datum Avsluta Sub
Om xRg(I).Värde <= Datum Då
xRg(I).EntireRow.Copy Destination:=Worksheets("ARCHIVED OASIS OPPORTUNITITIES").Range("A" & J + 1)
xRg(I).EntireRow.Delete
J = J + 1
Jag = Jag - 1
End If
Nästa
End Sub

Du måste lägga in VBA-skriptet i ThisWorkbook-kodfönstret och spara arbetsboken som en Excel-makroaktiverad arbetsbok.
Denna kommentar minimerades av moderatoren på webbplatsen
Tack Crystal, det fungerar bra.
Denna kommentar minimerades av moderatoren på webbplatsen
Crystal, jag var lite bråttom när jag svarade att koden fungerade. Jag öppnade min arbetsbok idag och rader som innehåller tidigare datumposter i kolumn L-cellen finns fortfarande i "aktuella oasis-kalkylblad" och har inte flyttats till det "arkiverade oasis-arbetsbladet" som förväntat. Några idéer om varför detta skulle vara fallet?
Denna kommentar minimerades av moderatoren på webbplatsen
De markerade cellerna finns i kolumn L med avseende på frågan ovan och är kriterierna (fram till dagens datum) för att flytta raden till det nya kalkylbladet. Hoppas denna bild hjälper.
Denna kommentar minimerades av moderatoren på webbplatsen
Detta är också en kopia av VBA-fönstret relaterat till ovanstående.
Denna kommentar minimerades av moderatoren på webbplatsen
Crystal, jag var lite bråttom när jag svarade att koden fungerade. Jag öppnade min arbetsbok idag och rader som innehåller tidigare datumposter i kolumn L-cellen finns fortfarande i "aktuella oasis-kalkylblad" och har inte flyttats till det "arkiverade oasis-arbetsbladet" som förväntat. Några idéer om varför detta skulle vara fallet?
Denna kommentar minimerades av moderatoren på webbplatsen
Kristall,

Eftersom jag inte kan ladda upp min arbetsbok kommer jag att återskapa raderna och kolumnerna här

ABCDEFGHIJKL
# Typ Borttagning Ansökan Ändra # Emissionsdatum Frågor Kundens leveransplats Projektförslag Förfallodag

1 SS SB 1234567 1 09/6/17 Inget arménamn Plats Drive Tank 09/10/17

Med hjälp av koden nedan vill jag att den ska flytta en hel rad till ett nytt kalkylblad när kolumn L når dagens datum. Om jag inte har fyllt i kalkylbladet på ett antal dagar skulle jag vilja att det använder "fram till dagens datum" sökning i kolumn L för att göra detsamma. Jag skulle också vilja att den gör detta automatiskt när jag öppnar arbetsboken om möjligt. Om jag för närvarande anger dagens datum i någon cell i raden, till exempel kolumn F när jag anger data, flyttas hela raden till arkivarbetsbladet. (Med Excel 2016)

[Modul 1-kod]

Sub DaveV()

Dim xRg As Range

Dim xCell As Range

Dim I As Long

Dim J As Long

I = Worksheets("CURRENT OASIS OPPORTUNITITIES").UsedRange.Rows.Count

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

Om J = 1 då
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITITIES").UsedRange) = 0 Då J = 0

End If

Set xRg = Worksheets("CURRENT OASIS OPPORTUNITITIES").Range("L1:L" & I)

On Error Resume Next

Application.ScreenUpdating = False

För varje xCell In xRg

Om CStr(xCell.Value) = Datum då

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

J = J + 1
End If

Nästa
Application.ScreenUpdating = True

End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
[Ark 1-kod]

Privata delarkivsförändring (ByVal-mål som område)
Dim xCell As Range
Dim I As Long
On Error Resume Next
Application.ScreenUpdating = False
Ställ in xCell = Target(1)
Om xCell.Value = Datum då
I = Arbetsblad("ARCHIVED OASIS OPPORTUNITITIES").UsedRange.Rows.Count
Om jag = 1 då
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITITIES").UsedRange) = 0 Då 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

Hoppas ovanstående hjälper men jag är inte en VBA-person förstår därför inte hur man får koden att göra det jag behöver. Din hjälp skulle uppskattas.
Denna kommentar minimerades av moderatoren på webbplatsen
Det finns ett stort fel i ditt manus!

Säg att du upptäckte att rad 7 har ordet "Klart" i kolumn C, så du kopierar det och tar bort raden.
När du väl har tagit bort raden kommer nästa rad i listan att vara rad 9 och inte 8, för när du väl tog bort den 7:e raden är innehållet på 8:e raden nu på rad 7, och alla rader gick upp 1 rad. Så nästa rad att kontrollera var tänkt att vara rad #8, men nu innehåller den data som tidigare fanns på rad #9, så varje gång du tar bort en rad, hoppar du faktiskt över en rad för att kontrollera!!!
Denna kommentar minimerades av moderatoren på webbplatsen
Kära Shau Alon,

Tack för din kommentar. Koden har uppdaterats med felet åtgärdat. Tack så mycket för din assistent.

Med vänlig hälsning, Crystal
Denna kommentar minimerades av moderatoren på webbplatsen
Jag tror att det här händer mig, det fortsätter att kopiera samma rad om och om igen även om det står att koden har uppdaterats. Det här är vad jag har:

Sub Cheezy()
'Uppdaterad av Kutools för 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("PURCHASE FORCAST").UsedRange.Rows.Count
J = Worksheets("Purchase Archive").UsedRange.Rows.Count
Om J = 1 då
Om Application.WorksheetFunction.CountA(Worksheets("Purchase Archive").UsedRange) = 0 Då J = 0
End If
Set xRg = Worksheets("PURCHASE FORCAST").Range("H3:H" & I)
On Error Resume Next
Application.ScreenUpdating = False
För K = 1 Till xRg.Count
Om CStr(xRg(K).Value) = "Ja" Då
xRg(K).EntireRow.Copy Destination:=Worksheets("Purchase Archive").Range("A" & J + 1)
xRg(K).EntireRow.Delete
Om CStr(xRg(K).Value) = "Ja" Då
K = K - 1
End If
J = J + 1
End If
Nästa
Application.ScreenUpdating = True
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Fred,
Varje gång du kör koden söker koden efter det angivna intervallet, så den kopierar samma rad om och om igen eftersom den inte kan se vilken rad som redan har kopierats. För att undvika att kopiera samma rad upprepade gånger kan du få koden att köras automatiskt när ett matchande värde anges i den angivna cellen.
Högerklicka på arkfliken i kalkylbladet med namnet "KÖPSFÖRSÄTTNING" och klicka Visa kod från snabbmenyn. Kopiera sedan följande VBA-kod i fönstret 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
Denna kommentar minimerades av moderatoren på webbplatsen
Kan någon hjälpa mig att få detta att fungera? Jag har försökt att ändra den del som måste matcha min fil, men det här kommer upp och jag är inte säker på vad jag ska göra.
Denna kommentar minimerades av moderatoren på webbplatsen
det står att filen inte stöds när jag försöker ladda upp excel-filen. Förlåt...kämpar med detta idag.
Denna kommentar minimerades av moderatoren på webbplatsen
Jag skulle vilja ha hjälp med en liknande uppgift, men lite annorlunda. Jag har 5 kolumner med siffror, cirka 25000 1 per kolumn, varje kolumn med rubriken 5-1. Jag skulle vilja kopiera hela raden till ett annat ark om värdet på kolumn 2 är större än noll, ELLER kolumn 3 är större än noll , ELLER kolumn 4 är mindre än noll, ELLER kolumn 5 är större än fem ELLER kolumn XNUMX är större än två etc. är detta möjligt?
Denna kommentar minimerades av moderatoren på webbplatsen
bilduppladdningen fungerar inte... förlåt.
Denna kommentar minimerades av moderatoren på webbplatsen
Hallå,
Använd uppladdningsknappen för denna.
Denna kommentar minimerades av moderatoren på webbplatsen
Så syftet är att se om någon av gaserna är över en gräns som jag kommer att sätta i formeln, hela löjromen kopieras till ett nytt ark.

Tack så mycket för all hjälp.
Denna kommentar minimerades av moderatoren på webbplatsen
Bild bifogad
Denna kommentar minimerades av moderatoren på webbplatsen
Kära Michael,
Kanske kan du lösa detta problem genom att använda ett Excel-tillägg. Här rekommenderar jag dig verktyget Välj specifika celler i Kutools för Excel. Med det här verktyget kan du enkelt välja alla rader i ett visst område om värdet för en angiven kolumn är större än eller mindre än ett tal. Efter att ha valt alla nödvändiga rader kan du manuellt kopiera och klistra in dem i ett nytt kalkylblad. Se nedan bifogad bild.

Du kan veta mer om den här funktionen genom att följa hyperlänken nedan.
https://www.extendoffice.com/product/kutools-for-excel/excel-select-specific-cells-rows.html
Denna kommentar minimerades av moderatoren på webbplatsen
tack för den här formeln, men jag hade ett problem som är när jag vill flytta raden till ett annat ark, det händer inte automatiskt. kan du ge mig en annan formel? så när jag ändrar värdet på cellens, flyttade den automatiskt.


tack
Denna kommentar minimerades av moderatoren på webbplatsen
Kära janang,
Koddosen sker inte automatiskt förrän du trycker på startknappen manuellt.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej,

Jag skulle vilja ha detta makro inställt men med 2 argument. Jag lyckades få makrot att fungera i min fil baserat på värdet på cellerna i kolumn O. Jag skulle dock vilja att makrot kontrollerar om kolumn S också är ifylld (eller <> "") innan du flyttar raden . Slutligen vill jag också att de kopierade raderna ska ha samma formatering som raderna i det andra arket. Förändrar det makrot helt?
Denna kommentar minimerades av moderatoren på webbplatsen
Kära Hugues,
Jag vet inte om jag förstår dig på rätt sätt. Du menar att om cellen i kolumn S är ifylld och cellen i kolumn O innehåller ett visst värde samtidigt, flytta då raden med formatering? Annars, inte flytta?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Crystal,

Ja det är precis vad jag menar. Faktum är att min data handlar om projekt. Min kolumn O är mitt projekts status och S slutdatumet för mitt projekt.
Jag vill att mina användare, de personer som har informationen och kommer att behöva infoga den, ska kunna "arkivera" ett projekt ENDAST om de har sin status som "Stängt" och de har infogat ett "Slutdatum".


Jag hoppas att detta hjälper till att klargöra saker och ting
Denna kommentar minimerades av moderatoren på webbplatsen
Kära Hugues,
Förlåt för att jag svarar så sent. Följande VBA-kod kan hjälpa dig att lösa problemet. Följ stegen i den här artikeln för att tillämpa VBA-skriptet.

Sub MoveRowBasedOnCellValue()
Dim xRgStatus As Range
Dim xRgDate 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
Om J = 1 då
Om Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Då J = 0
End If
Set xRgStatus = Worksheets("Sheet1").Range("O1:O" & I)
Set xRgDate = Worksheets("Sheet1"). Range("S1:S" & I)
On Error Resume Next
Application.ScreenUpdating = False
Application.CutCopyMode = False
xRgStatus(1).EntireRow.Copy
Worksheets("Sheet2").Range("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
För K = 2 Till xRgStatus.Count
Om CStr(xRgStatus(K).Value) = "Stängd" Då
Om (xRgDate(K).Value <> "") Och (TypeName(xRgDate(K).Value) = "Datum") Då
xRgStatus(K).EntireRow.Copy
Worksheets("Sheet2").Range("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
End If
End If
Nästa
Application.CutCopyMode = Sant
Application.ScreenUpdating = True
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Kära Crystal,

Tack så mycket för din hjälp!

Hälsningar,

Hugues
Denna kommentar minimerades av moderatoren på webbplatsen
Hallå,


Hur kopierar jag raderna istället för att flytta dem?
Denna kommentar minimerades av moderatoren på webbplatsen
Hallå,


Jag vet att detta har postats några gånger men jag kan inte hitta svaret. Hur kan jag kopiera materialet till det nya bladet och INTE radera det från originalarket?
Denna kommentar minimerades av moderatoren på webbplatsen
Kära Mike,
Om du vill kopiera raderna istället för att ta bort dem kan nedanstående VBA-kod hjälpa dig. Tack för din kommentar!

Sub Cheezy()
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
Om J = 1 då
Om Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Då J = 0
End If
Set xRg = Worksheets("Sheet1"). Range("C1:C" & I)
On Error Resume Next
Application.ScreenUpdating = False
För K = 1 Till xRg.Count
Om CStr(xRg(K).Value) = "Klar" Då
xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
J = J + 1
End If
Nästa
Application.ScreenUpdating = True
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Hej,

Jag är ny på att använda makron, är det möjligt att klistra in data nedan efter ett visst värde och kommer att upprepas till slutet av kolumnen?
Så här:

Överför "Blå" efter "Färg"

A1 = Blå
A5= Färg
A6= (överföring "Blå" här)
och så vidare ...
Denna kommentar minimerades av moderatoren på webbplatsen
Dear John,
Menar du att om en cell innehåller "Färg" i en kolumn, kopiera texten i den första cellen till cellen under "Färg" och upprepa kopiera denna text till slutet av kolumnen?
Det finns inga kommentarer här ännu
Ladda fler
Lämna dina kommentarer
Postar som gäst
×
Betygsätt detta inlägg:
0   Tecken
Föreslagna platser

Följ oss

Copyright © 2009 - www.extendoffice.com. | Alla rättigheter förbehållna. Drivs av ExtendOffice. | | Sitemap
Microsoft och Office-logotypen är varumärken eller registrerade varumärken som tillhör Microsoft Corporation i USA och / eller andra länder.
Skyddad av Sectigo SSL