• Merhaba Ziyaretçi,
    Microsoft 365 Uygulamaları ile ilgili yeni haberler, dikkat çekici konular, ilgi ile takip edeceğiniz yazılar için.

    Abone Olun
  • ESTE - Microsoft Office Eğitimleri

    Yeni yıl Microsoft Office Eğitim planlarınız için bütçenizi oluşturmadan önce ESTE eğitim kalitesi ile tanışın. 🙌
    Kullanıcıların ihtiyacı olan yazılı materyal, dosya ve video kaynağı desteğimiz ile tüm ofis çalışanlarının iş süreçlerini rahatlatacak eğitimler planlayın. 🎯
    Microsoft Office eğitimlerimiz hakkında detaylı bilgi için bize ulaşın.

    👉 Microsoft Office Eğitim Talebi

Yardım Makro kodunun çalıştığı sütunu değiştirmek

hadromer

Yeni Üye
Katılım
3 Ocak 2021
Mesajlar
20
En iyi yanıt
0
Puanları
3
Yaş
33
Konum
Ankara
Ad Soyad
Ömer
Office Vers.
Office 2019 TR
Merhaba,
Daha önce Çözüldü - Bir sütundaki verileri ayrı ayrı sayfalara kopyalamak bu linkte Murat Bey'in yardımlarıyla sorunum çözülmüştü. Şimdi o dosyadaki sütunlarda bir değişiklik yapmak zorunda kaldım. Kodu inceleyince göreceksiniz formül kaynak sayfasındaki verileri "T" sütununa kopyalayıp ondan sonra işlem yapıyordu. Ancak yeni dosyamda İşlem yapılacak olan sütun "V" sütunu oldu. Aşağıdaki kodda t hücresi ile ilgili yerlere V yazsam yine aynı şekilde çalışır mı ?
Kod:
Sub SutunlariTasiveSayfalariOlustur()
    On Error Resume Next
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = FALSE
    Application.DisplayStatusBar = FALSE
    Application.EnableEvents = FALSE
    Dim kaynak As Worksheet
    Dim sablon As Worksheet
    
    Set kaynak = ThisWorkbook.Sheets("Kaynak")
    Set sablon = ThisWorkbook.Sheets("Şablon")
    
    sablon.Range("T:T").ClearContents
    sonSutun = kaynak.Range("XFD2").End(xlToLeft).Column
    sonSatir = kaynak.Range("A65536").End(xlUp).Row
    
    For i = 1 To sonSutun
        kaynak.Range(Cells(2, i), Cells(sonSatir, i)).Copy
        sablon.Range("T2").PasteSpecial
        sablon.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        ActiveSheet.Name = kaynak.Cells(2, i).Value
        ActiveSheet.Range("T2").Select
        sablon.Range("T:T").ClearContents
        kaynak.Select
    Next i
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = TRUE
    Application.DisplayStatusBar = TRUE
    Application.EnableEvents = TRUE
    MsgBox "İşlem tamamlandı."
End Sub
 
Üst Alt