Przejdź do głównej zawartości

Jak skopiować wiersze z wielu arkuszy na podstawie kryteriów do nowego arkusza?

Przypuśćmy, że masz skoroszyt z trzema arkuszami roboczymi, które mają takie samo formatowanie, jak pokazano na poniższym zrzucie ekranu. Teraz chcesz skopiować wszystkie wiersze z tych arkuszy, w których kolumna C zawiera tekst „Ukończono”, do nowego arkusza. Jak możesz szybko i łatwo rozwiązać ten problem bez kopiowania i wklejania ich ręcznie jeden po drugim?

Skopiuj wiersze z wielu arkuszy roboczych na podstawie kryteriów do nowego arkusza z kodem VBA


Skopiuj wiersze z wielu arkuszy roboczych na podstawie kryteriów do nowego arkusza z kodem VBA

Poniższy kod VBA może pomóc w skopiowaniu określonych wierszy ze wszystkich arkuszy w skoroszycie na podstawie określonego warunku do nowego arkusza. Zrób tak:

1. Przytrzymaj ALT + F11 klawisze, aby otworzyć Microsoft Visual Basic for Applications okno.

2. Kliknij wstawka > Modułi wklej następujący kod w oknie modułu.

Kod VBA: kopiuj wiersze z wielu arkuszy na podstawie kryteriów do nowego arkusza

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

Note: W powyższym kodzie:

  • Tekst "Zakończony" w tym xRStr = "Ukończono" skrypt wskazuje określony warunek, na podstawie którego chcesz kopiować wiersze;
  • C: C w tym Ustaw xRg = xWs.Range („C: C”) skrypt wskazuje konkretną kolumnę, w której znajduje się warunek.

3. Następnie naciśnij F5 klucz do uruchomienia tego kodu, a wszystkie wiersze z określonym warunkiem zostały skopiowane i wklejone do nowego arkusza roboczego o nazwie Kutools for Excel w bieżącym skoroszycie. Zobacz zrzut ekranu:


Więcej względnych artykułów dotyczących ściągania lub kopiowania danych:

  • Skopiuj dane do innego arkusza roboczego z zaawansowanym filtrem w programie Excel
  • Zwykle możemy szybko zastosować funkcję Filtr zaawansowany, aby wyodrębnić dane z surowych danych w tym samym arkuszu. Ale czasami, gdy spróbujesz skopiować przefiltrowany wynik do innego arkusza, pojawi się następujący komunikat ostrzegawczy. W takim przypadku jak poradzisz sobie z tym zadaniem w programie Excel?
  • Kopiuj wiersze, jeśli kolumna zawiera określony tekst / wartość w programie Excel
  • Przypuśćmy, że chcesz znaleźć komórki zawierające określony tekst lub wartość w kolumnie, a następnie skopiować cały wiersz, w którym znajduje się znaleziona komórka, jak sobie z tym poradzić? Tutaj przedstawię kilka metod, aby sprawdzić, czy kolumna zawiera określony tekst lub wartość, a następnie skopiuję cały wiersz w programie Excel.

  • Pasek Super Formula (łatwo edytować wiele wierszy tekstu i formuły); Układ do czytania (łatwe odczytywanie i edytowanie dużej liczby komórek); Wklej do filtrowanego zakresu...
  • Scal komórki / wiersze / kolumny i przechowywanie danych; Podziel zawartość komórek; Połącz zduplikowane wiersze i sumę / średnią... Zapobiegaj zduplikowanym komórkom; Porównaj zakresy...
  • Wybierz Duplikat lub Unikalny Wydziwianie; Wybierz puste wiersze (wszystkie komórki są puste); Super Find i Fuzzy Find w wielu zeszytach ćwiczeń; Losowy wybór ...
  • Dokładna kopia Wiele komórek bez zmiany odwołania do formuły; Automatyczne tworzenie odniesień do wielu arkuszy; Wstaw punktory, Pola wyboru i nie tylko ...
  • Ulubione i szybkie wstawianie formuł, Zakresy, wykresy i obrazy; Szyfruj komórki z hasłem; Utwórz listę mailingową i wysyłaj e-maile ...
  • Wyodrębnij tekst, Dodaj tekst, Usuń według pozycji, Usuń przestrzeń; Tworzenie i drukowanie podsumowań stronicowania; Konwertuj zawartość komórek i komentarze...
  • Super filtr (zapisz i zastosuj schematy filtrów do innych arkuszy); Zaawansowane sortowanie według miesiąca / tygodnia / dnia, częstotliwości i innych; Specjalny filtr pogrubieniem, kursywą ...
  • Połącz skoroszyty i arkusze robocze; Scal tabele na podstawie kluczowych kolumn; Podziel dane na wiele arkuszy; Konwersja wsadowa xls, xlsx i PDF...
  • Grupowanie tabel przestawnych według numer tygodnia, dzień tygodnia i więcej ... Pokaż odblokowane, zablokowane komórki w różnych kolorach; Podświetl komórki, które mają formułę / nazwę...
karta kte 201905
  • Włącz edycję i czytanie na kartach w programach Word, Excel, PowerPoint, Publisher, Access, Visio i Project.
  • Otwieraj i twórz wiele dokumentów w nowych kartach tego samego okna, a nie w nowych oknach.
  • Zwiększa produktywność o 50% i redukuje setki kliknięć myszką każdego dnia!
officetab dół
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