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

Jak kopírovat řádky z více listů na základě kritérií do nového listu?

Předpokládejme, že máte sešit se třemi listy, které mají stejné formátování jako níže uvedený snímek obrazovky. Nyní chcete zkopírovat všechny řádky z těchto listů, jejichž sloupec C obsahuje text „Dokončeno“, do nového listu. Jak byste mohli tento problém vyřešit rychle a snadno, aniž byste je po jednom ručně kopírovali a vkládali?

Zkopírujte řádky z více listů na základě kritérií do nového listu s kódem VBA


Zkopírujte řádky z více listů na základě kritérií do nového listu s kódem VBA

Následující kód VBA vám pomůže zkopírovat konkrétní řádky ze všech listů v sešitu na základě určité podmínky do nového listu. Udělejte prosím toto:

1. Podržte ALT + F11 klávesy pro otevření Microsoft Visual Basic pro aplikace okno.

2, klikněte Vložit > Modula vložte následující kód do okna modulu.

Kód VBA: Zkopírujte řádky z více listů na základě kritérií do nového listu

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

Poznámka: Ve výše uvedeném kódu:

  • Text "Dokončeno" v tomhle xRStr = "Dokončeno" skript označuje konkrétní podmínku, na kterou chcete kopírovat řádky;
  • C: C v této Nastavit xRg = xWs.Range ("C: C") skript označuje konkrétní sloupec, kde se podmínka nachází.

3. Poté stiskněte tlačítko F5 klíč ke spuštění tohoto kódu a všechny řádky se specifickou podmínkou byly zkopírovány a vloženy do nového listu s názvem Kutools pro Excel v aktuálním sešitu. Viz screenshot:


Více relativních článků o stahování nebo kopírování dat:

  • Zkopírujte data do jiného listu s pokročilým filtrem v aplikaci Excel
  • Normálně můžeme rychle použít funkci Rozšířený filtr k extrakci dat ze surových dat ve stejném listu. Ale někdy, když se pokusíte zkopírovat filtrovaný výsledek do jiného listu, zobrazí se následující varovná zpráva. Jak byste v tomto případě mohli s tímto úkolem pracovat v aplikaci Excel?

  • Super Formula Bar (snadno upravit více řádků textu a vzorce); Rozložení pro čtení (snadno číst a upravovat velké množství buněk); Vložit do filtrovaného rozsahu...
  • Sloučit buňky / řádky / sloupce a uchovávání údajů; Rozdělit obsah buněk; Zkombinujte duplicitní řádky a součet / průměr... Zabraňte duplicitním buňkám; Porovnat rozsahy...
  • Vyberte možnost Duplikovat nebo Jedinečný Řádky; Vyberte prázdné řádky (všechny buňky jsou prázdné); Super hledání a fuzzy hledání v mnoha sešitech; Náhodný výběr ...
  • Přesná kopie Více buněk beze změny odkazu na vzorec; Automaticky vytvářet reference do více listů; Vložte odrážky, Zaškrtávací políčka a další ...
  • Oblíbené a rychlé vkládání vzorců„Rozsahy, grafy a obrázky; Šifrovat buňky s heslem; Vytvořte seznam adresátů a posílat e-maily ...
  • Extrahujte text, Přidat text, Odebrat podle pozice, Odebrat mezeru; Vytváření a tisk mezisoučtů stránkování; Převod mezi obsahem buněk a komentáři...
  • Super filtr (uložit a použít schémata filtrů na jiné listy); Rozšířené řazení podle měsíce / týdne / dne, frekvence a dalších; Speciální filtr tučnou kurzívou ...
  • Kombinujte sešity a pracovní listy; Sloučit tabulky na základě klíčových sloupců; Rozdělte data do více listů; Dávkový převod xls, xlsx a PDF...
  • Seskupování kontingenčních tabulek podle číslo týdne, den v týdnu a další ... Zobrazit odemčené, zamčené buňky různými barvami; Zvýrazněte buňky, které mají vzorec / název...
karta kte 201905
  • Povolte úpravy a čtení na kartách ve Wordu, Excelu, PowerPointu, Publisher, Access, Visio a Project.
  • Otevřete a vytvořte více dokumentů na nových kartách ve stejném okně, nikoli v nových oknech.
  • Zvyšuje vaši produktivitu o 50%a snižuje stovky kliknutí myší každý den!
officetab dno
Komentáře (2)
Zatím žádné hodnocení. Buďte první, kdo ohodnotí!
Tento komentář byl moderátorem webu minimalizován
Dobrý den, mnohokrát děkuji za výše uvedený kód, vyřešil mi problém se složitým souborem; řešení, které už nějakou dobu hledám. Děkuji..mám jeden dotaz. Jak změním kód tak, aby kopíroval řádky, ale pouze ze sloupce A do sloupce Q, tedy ne Entire.Row? Předem děkuji a skvělá práce!
Tento komentář byl moderátorem webu minimalizován
Dobrý den,

moc děkuji za kód. Mám otázku: kód běží hladce na některých mých listech, ale vypadá to, že v některých jiných vstupuje do nekonečné smyčky, což způsobuje zhroucení aplikace Excel. Jaký by mohl být důvod?
Zatím zde nejsou žádné komentáře
Zanechat své připomínky
Odesílání jako host
×
Ohodnoťte tento příspěvek:
0   Postavy
Doporučená umístění

Sociální sítě

Copyright © 2009 - www.extendoffice.com. | Všechna práva vyhrazena. Poháněno ExtendOffice. | |. | Sitemap
Microsoft a logo Office jsou ochranné známky nebo registrované ochranné známky společnosti Microsoft Corporation ve Spojených státech a / nebo jiných zemích.
Chráněno Sectigo SSL