Belirtilen Sayfalar Dışında Uygulama Hatası

[miha]

Arkadaşlar Merhaba. Dış kaynaktan verileri import ettiğim bir Macro var. Bu Makronun kod içersinde özellikle belirttiğim iki çalışma sayfası hariç diğer tüm sayfalara uygulanmasını istiyorum Ancak Makroyu çalıştırdığımda sadece Aktif sayfaya uygulayıp diğer sayfalara uygulamıyor. Sizce nerede hata yapıyorum? Nereyi nasıl değiştirmem gerekiyor. Yardımcı olabilecek arkadaşlara şimdiden çok teşekkür ederim.

Sub DataTransfer()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "HAM SAYFASI" And xWs.Name <> "DATA SAYFASI" Then
              Dim FilePath As String
              FilePath = "TEXT;C:\Users\MACHA\Desktop\FATURALAR\" & Cells(19, 6).Value
              With ActiveSheets.QueryTables.Add(Connection:=FilePath, Destination:=Range("$A$1"))
                .Name = Range("G19").Value
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = 65001
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = True
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = True
                .TextFileSpaceDelimiter = False
                .TextFileColumnDataTypes = Array(4, 1, 1, 1, 1, 9, 9)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
              End With
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "İşlem tamamlandı.", vbInformation, "..:: ZAMAN YAYI ::.."
End Sub

 

[Muzaffer Ali]

Merhaba.

With ActiveSheets yazmışsınız onu With xWs ile değiştirin.

Başka hata görünmüyor. Bu hatadan dolayı aslında kodlar hiç çalışmaması gerekiyor.

 

[miha]

Merhaba.

With ActiveSheets yazmışsınız onu With xWs ile değiştirin.

Başka hata görünmüyor. Bu hatadan dolayı aslında kodlar hiç çalışmaması gerekiyor.

Sayın @dalgalikur öncelikle ilginiz için çok teşekkür ederim. Belirttiğiniz üzere "With ActiveSheets" yerine "With xWs" olarak değiştirdim.
Bu değişiklikten önce sadece aktif sayfada uygulama yaparken bu değişiklik sonrası bu kez onu da yapmayarak direkt hata verdi?

 

[Muzaffer Ali]

Herhangi bir hata mesajı veriyor mu? Veriyorsa mesajı da yazar mısınız?

 

[miha]

Herhangi bir hata mesajı veriyor mu? Veriyorsa mesajı da yazar mısınız?

Sayın @dalgalikur belirttiğiniz düzeltmeyi yaptıktan sonra aldığım hata mesajı aynen şöyle:

Run-time error '-2147024809(80070057)':
The destination range is not on the same worksheet that the Query table is being created on.

 

[miha]

Sayın @dalgalikur hatanın nedenini buldum Macroda "Destination:=Range("$A$1")" olarak belirtilen satırda Range'in başına da "xWs" ekleyince "Destination:=xWs.Range("$A$1")" olarak değiştirince sorun çözüldü. Çok sevindim ya İlginiz için tekrardan teşekkürler. Başta verdiğiniz tüyoyu iki yerde de kullanmak gerekliymiş Çok teşekkürler tekrardan.