hadromer
Altın Üye
- Katılım
- 23 Ekim 2015
- Mesajlar
- 402
- Excel Vers. ve Dili
- LTSC Professional Plus 2021 64 Bit Türkçe
- Altın Üyelik Bitiş Tarihi
- 26-04-2028
Merhaba,
Daha önce yardım aldığım kod sayesinde sorunum çözülmüştü. Dosyamda kaynak ve şablon olmak üzere iki ayrı sayfa vardı. Kodu inceleyince göreceksiniz formül kaynak sayfasındaki verileri "T" sütununa kopyalayıp ondan sonra işlem yapıyordu. Ancak yeni dosyamda yaptığım eklemeler dolayısıyla İş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ı ?
Eski dosyamın linki : https://s7.dosya.tc/server19/xuik67/Ornek.xlsx.html
Talep ederseniz yeni dosyamın linkini de eklerim
Daha önce yardım aldığım kod sayesinde sorunum çözülmüştü. Dosyamda kaynak ve şablon olmak üzere iki ayrı sayfa vardı. Kodu inceleyince göreceksiniz formül kaynak sayfasındaki verileri "T" sütununa kopyalayıp ondan sonra işlem yapıyordu. Ancak yeni dosyamda yaptığım eklemeler dolayısıyla İş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ı ?
Eski dosyamın linki : https://s7.dosya.tc/server19/xuik67/Ornek.xlsx.html
Talep ederseniz yeni dosyamın linkini de eklerim
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