Birden fazla çalışma sayfasındaki kriterlere uygun satırları yeni bir sayfaya nasıl kopyalarsınız?

Diyelim ki aşağıdaki ekran görüntüsünde gösterildiği gibi, aynı biçimlendirmeye sahip üç çalışma sayfası içeren bir çalışma kitabınız var. Şimdi, C sütununda “Completed” metnini içeren tüm satırları yeni bir çalışma sayfasına kopyalamak istiyorsunuz. Bu işlemi tek tek elle kopyalayıp yapıştırmadan hızlı ve kolay bir şekilde nasıl gerçekleştirebilirsiniz?

VBA koduyla birden fazla çalışma sayfasından kriterlere göre satırları yeni bir sayfaya kopyalama

---

VBA koduyla birden fazla çalışma sayfasından kriterlere göre satırları yeni bir sayfaya kopyalama

Aşağıdaki VBA kodu, çalışma kitabınızdaki tüm çalışma sayfalarından belirli bir koşulu karşılayan satırları tek bir Yeni Çalışma Sayfası’na kopyalamanıza yardımcı olur. İşte nasıl yapacağınız:

1. ALT + F11 tuşlarına basarak Microsoft Visual Basic for Applications penceresini açın.

2. Ekle > Modül seçeneğine tıklayın ve aşağıdaki kodu Modül Penceresine yapıştırın.

VBA kodu: Birden fazla sayfadan kriterlere göre satırları yeni bir sayfaya kopyalama

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

Not: Yukarıdaki kodda:

• “Completed” metni bu xRStr = "Completed"betiğinde, satırların kopyalanacağına karar vermek için dayanacağınız özel koşulu belirtir;
• C:C, bu Set xRg = xWs.Range("C:C") betiğinde, koşulun bulunduğu sütunu belirtir.

3. Ardından, bu kodu çalıştırmak için F5 tuşuna basın; böylece belirli koşulu sağlayan tüm satırlar, Geçerli Çalışma Kitabı’nda yer alan “Kutools for Excel” adlı yeni bir çalışma sayfasına kopyalanır ve yapıştırılır. Ekran görüntüsüne bakın:

---

---

Daha fazla ilgili veri çekme veya kopyalama makalesi: