Soru VBA SAYFAYI TEMİZLEME

[Tefo]

Merhabalar,

Elimde aşağıdaki gibi bir makro kodu var ve başka bir exceldeki verileri makronun çalıştığı excele filtreleme yaparak yapıştırmasını sağlıyorum fakat makro çalışmadan önce 2.exceldeki bütün verileri silip sonrasında 1.excelden verileri çekmesini istiyorum. Desteklerinizi bekliyorum.

Sub FiltreVeAktar()
Dim wb1 As Workbook ' 1. Excel dosyası
Dim wb2 As Workbook ' 2. Excel dosyası (mevcut dosya)
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wsName As String
Dim srcRange As Range, destRange As Range
Dim lastRow As Long
Dim kriter As String
Dim filtreSutun As Integer

' Filtre kriteri
kriter = ThisWorkbook.Sheets("Map").Range("C4").Value

Dim filtreSutunlar As Object
Set filtreSutunlar = CreateObject("Scripting.Dictionary")
filtreSutunlar.Add "Sayfa 1", "Z" ' Sayfa1 için Z sütunu
filtreSutunlar.Add "Sayfa 2", "AF" ' Sayfa2 için AF sütunu
filtreSutunlar.Add "Sayfa 3", "X" ' Sayfa3 için X sütunu
filtreSutunlar.Add "Sayfa 4", "Z" ' Sayfa4 için Z sütunu

' 1. Excel dosyasını aç (1. Excel dosyasının konumu belirtilmiş)
Set wb1 = Workbooks.Open(ThisWorkbook.Sheets("Map").Range("A3").Value)

' 2. Excel dosyasını (mevcut dosya) tanımla
Set wb2 = ThisWorkbook


' 1. Excel'deki tüm sayfaları döngüye al
For Each ws1 In wb1.Sheets
wsName = ws1.Name ' 1. Excel'deki sayfa adı

' Eğer 2. Excel'de aynı isimli sayfa varsa
On Error Resume Next
Set ws2 = wb2.Sheets(wsName)
On Error GoTo 0

If Not ws2 Is Nothing Then
' İlgili sayfa için filtrelenecek sütunu belirle
If filtreSutunlar.exists(wsName) Then
filtreSutun = ws1.Columns(filtreSutunlar(wsName)).Column ' Sütun numarasını al

' 1. Excel'deki veri aralığını belirle
lastRow = ws1.Cells(ws1.Rows.Count, filtreSutun).End(xlUp).Row
Set srcRange = ws1.Range("A1").Resize(lastRow, ws1.Columns.Count)

' Filtreleme yap
srcRange.AutoFilter Field:=filtreSutun, Criteria1:=ThisWorkbook.Sheets("Map").Range("C4").Value

' Filtrelenen verileri 2. Excel'in aynı isimli sayfasına aktar
Set destRange = ws2.Cells(1, 1) ' İlk hücreden itibaren kopyalama başlar
srcRange.SpecialCells(xlCellTypeVisible).Copy destRange

' Filtreyi kaldır
ws1.AutoFilterMode = False
Else
MsgBox wsName & " adlı sayfa için filtrelenecek sütun belirtilmedi!"
End If

' Sayfa işlemi tamamlandıktan sonra ws2'yi temizle
Set ws2 = Nothing
End If
Next ws1

' 1. Excel dosyasını kapat
wb1.Close SaveChanges:=False

MsgBox "Veriler sorunsuz sekilde yüklendi!"
End Sub

 

[Tasarım]

Verileri yapıştıracağınız sayfanın başına aşağıda örnek olarak yazdığım kodu eklerseniz silebilirsiniz.
Örnek: Sheets("Sayfa1").select
Range("A1:F10000").select
Selection.ClearContents
Range("A1").select

Bu kodları kendi sayfanıza uyarlayınız.

 

[Tefo]

Her sayfa için ayrı ayrı mı yapmalıyım bunu ws2 şeklinde tanımladığım yere ekleyebilir miyim

 

[Muzaffer Ali]

Merhaba
Bu satırın altına

Set ws2 = wb2.Sheets(wsName)

Bu satırı ekleyin.

ws2.Cells.ClearContents

 

[Tefo]

Teşekkür ederim. Bu şekilde çözebildim.

Merhaba
Bu satırın altına

Set ws2 = wb2.Sheets(wsName)

Bu satırı ekleyin.

ws2.Cells.ClearContents