Hoppa till huvudinnehåll

Hur kopierar jag rader från flera kalkylblad baserat på kriterier till ett nytt ark?

Om du antar att du har en arbetsbok med tre kalkylblad som har samma formatering som bilden nedan visas. Nu vill du kopiera alla raderna från dessa kalkylblad, vilken kolumn C innehåller texten "Slutförd" till ett nytt kalkylblad. Hur kunde du lösa detta problem snabbt och enkelt utan att kopiera och klistra in dem en efter en manuellt?

Kopiera rader från flera kalkylblad baserat på kriterier till ett nytt ark med VBA-kod


Kopiera rader från flera kalkylblad baserat på kriterier till ett nytt ark med VBA-kod

Följande VBA-kod kan hjälpa dig att kopiera specifika rader från alla kalkylblad i arbetsboken baserat på ett visst tillstånd till ett nytt kalkylblad. Gör så här:

1. Håll ner ALT + F11 nycklar för att öppna Microsoft Visual Basic för applikationer fönster.

2. Klicka Insert > Modulernaoch klistra in följande kod i modulfönstret.

VBA-kod: Kopiera rader från flera ark baserat på kriterier till ett nytt ark

Public Sub CopyRows_ValuesAndNumberFormats()
Dim xWs As Worksheet
Dim xCWs As Worksheet
Dim xRg As Range
Dim xStrName As String
Dim xRStr As String
Dim xRRg As Range
Dim xC As Integer
On Error Resume Next
Application.DisplayAlerts = False
xStr = "Kutools for Excel"
xRStr = "Completed"
Set xCWs = ActiveWorkbook.Worksheets.Item(xStr)
If Not xCWs Is Nothing Then
    xCWs.Delete
End If
Set xCWs = ActiveWorkbook.Worksheets.Add
xCWs.Name = xStr
xC = 1
For Each xWs In ActiveWorkbook.Worksheets
    If xWs.Name <> xStr Then
        Set xRg = xWs.Range("C:C")
        Set xRg = Intersect(xRg, xWs.UsedRange)
        For Each xRRg In xRg
            If xRRg.Value = xRStr Then
               xRRg.EntireRow.Copy
               xCWs.Cells(xC, 1).PasteSpecial xlPasteValuesAndNumberFormats
               xC = xC + 1
            End If
        Next xRRg
    End If
Next xWs
Application.DisplayAlerts = True
End Sub

Anmärkningar: I ovanstående kod:

  • Texten "Avslutade" i denna xRStr = "Slutfört" skriptet anger det specifika villkor som du vill kopiera rader baserat på;
  • C: C I detta Ställ in xRg = xWs.Range ("C: C") skript indikerar den specifika kolumnen där villkoret finns.

3. Tryck sedan på F5 nyckel för att köra den här koden, och alla rader med det specifika villkoret har kopierats och klistrats in i ett nytt kalkylblad med namnet Kutools för Excel i den aktuella arbetsboken. Se skärmdump:


Mer relativa drag- eller kopieringsdataartiklar:

  • Kopiera data till ett annat kalkylblad med avancerat filter i Excel
  • Normalt kan vi snabbt använda funktionen Avancerat filter för att extrahera data från rådata i samma kalkylblad. Men ibland, när du försöker kopiera det filtrerade resultatet till ett annat kalkylblad, får du följande varningsmeddelande. I det här fallet, hur kan du hantera den här uppgiften i Excel?
  • Kopiera rader till nytt ark baserat på kolumnkriterier i Excel
  • Det finns till exempel en fruktköpstabell, och nu måste du kopiera poster till ett nytt ark baserat på specificerad frukt, hur gör man det enkelt i Excel? Här kommer jag att introducera ett par metoder för att kopiera rader till ett nytt ark baserat på kolumnkriterier i Excel.
  • Kopiera rader om kolumn innehåller specifik text / värde i Excel
  • Antar att du vill ta reda på celler som innehåller specifik text eller värde i en kolumn och sedan kopiera hela raden där den hittade cellen finns, hur kan du hantera den? Här kommer jag att presentera ett par metoder för att hitta om kolumnen innehåller specifik text eller värde och sedan kopiera hela raden i Excel.

  • 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 och förvaring av data; Delat cellinnehåll; Kombinera duplicerade rader och summa / genomsnitt... 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 ...
  • Favorit och sätt snabbt in formler, Intervall, diagram och bilder; Kryptera celler med lösenord; Skapa e-postlista och skicka e-post ...
  • 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...
  • Gruppering av pivottabell efter veckonummer, veckodagen och mer ... Visa olåsta, låsta celler av olika färger; Markera celler som har formel / namn...
kte-flik 201905
  • 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
Comments (2)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hi,

thank you very much for the code. I have a question: the code runs smoothly on some of my sheets, but looks like enters an infinite loop in some other ones which makes excel crash. What could the reason be?
This comment was minimized by the moderator on the site
Hello there, thank you so much for the code above, it solved me a problem with a complex file; a solution I have been looking for a while now. Thank you..I have one question. How do I change the code so that it copies the rows but only from colum A to colum Q, so not Entire.Row?Thank you in advance and great work!
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations