Erdinç FIRTINA
Altın Üye
- Katılım
- 14 Şubat 2007
- Mesajlar
- 400
- Excel Vers. ve Dili
- excel 2003 türkçe
- Altın Üyelik Bitiş Tarihi
- 15-05-2026
Değerli arkadaşlar,
bir sayfadaki tablodaki bilgileri sayfalara aktarırken sayfayı her seferinde silmeden sadece sayfaların belirli bölümlerine veri aktarılabilir mi?
Yani diyelim ki aynı sütunda bulunan 5 isme ait çok saydaki satırda yer alan verileri birinci seferde 5 değişik sayfaya dağıttım. bundan sonra veri eklediğimde sayfaların tekrar silinmeden (verilerin bulunduğu satır ve sütunlar silinebilir) bu 5 üyeye ait çok sayıda satırda yer alan veriler aynı sayfalara dağıtılabilir mi?
Aşağıdaki formülden yararlanarak çözmeye çalıştım "delete" olmadan sayfalara veriler aktarılamıyor. delete ile sayfalar siliniyor.
lütfen bu konuda yardım edermisiniz?
Fonksiyon oluşturarak verilerimi dağıtıyorum ama çok veri olduğu için sürekli hesaplama yaptığından dosya çok şişiyor ve yavaş çalışıyor.
Bu sorunumu nasıl bir yöntemle çözebilirim. Lütfen yardım.
Sub SAYFALARA_AKTAR()
Application.ScreenUpdating = False
Set SV = Sheets("VERİ")
If WorksheetFunction.CountA(SV.[F2:F65536]) = 0 Then GoTo SON
SAY = Worksheets.Count
If SAY > 1 Then
For X = 2 To SAY
Application.DisplayAlerts = False
Sheets(2).Delete
Application.DisplayAlerts = True
Next X
End If
SV.[H:H].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=SV.[IV1], Unique:=True
For Y = 2 To SV.[IV65536].End(3).Row
Sheets.Add After:=Sheets(Worksheets.Count)
ActiveSheet.Name = SV.Cells(Y, "IV")
SATIR = 1
For Z = 2 To SV.[F65536].End(3).Row
If ActiveSheet.Name = UCase(Replace(Replace(SV.Cells(Z, "H"), "i", "İ"), "ı", "I")) Then
SATIR = SATIR + 1
Range("M1:R1") = SV.[F1:K1].Value
Range("M1:R1").HorizontalAlignment = xlCenter
Range("M1:R1").Font.Bold = True
Cells.EntireColumn.AutoFit
Cells(SATIR, "M") = SV.Cells(Z, "F")
Cells(SATIR, "N") = SV.Cells(Z, "G")
Cells(SATIR, "O") = SV.Cells(Z, "H")
Cells(SATIR, "P") = SV.Cells(Z, "I")
Cells(SATIR, "Q") = SV.Cells(Z, "J")
Cells(SATIR, "R") = SV.Cells(Z, "K")
End If
Next Z
Next Y
SV.Select
Application.ScreenUpdating = True
MsgBox "AKTARMA İŞLEMİ TAMAMLANMIŞTIR.", vbInformation
Exit Sub
SON:
MsgBox "AKTARILACAK KAYIT BULUNAMAMIŞTIR.", vbExclamation
Application.ScreenUpdating = True
End Sub
bir sayfadaki tablodaki bilgileri sayfalara aktarırken sayfayı her seferinde silmeden sadece sayfaların belirli bölümlerine veri aktarılabilir mi?
Yani diyelim ki aynı sütunda bulunan 5 isme ait çok saydaki satırda yer alan verileri birinci seferde 5 değişik sayfaya dağıttım. bundan sonra veri eklediğimde sayfaların tekrar silinmeden (verilerin bulunduğu satır ve sütunlar silinebilir) bu 5 üyeye ait çok sayıda satırda yer alan veriler aynı sayfalara dağıtılabilir mi?
Aşağıdaki formülden yararlanarak çözmeye çalıştım "delete" olmadan sayfalara veriler aktarılamıyor. delete ile sayfalar siliniyor.
lütfen bu konuda yardım edermisiniz?
Fonksiyon oluşturarak verilerimi dağıtıyorum ama çok veri olduğu için sürekli hesaplama yaptığından dosya çok şişiyor ve yavaş çalışıyor.
Bu sorunumu nasıl bir yöntemle çözebilirim. Lütfen yardım.
Sub SAYFALARA_AKTAR()
Application.ScreenUpdating = False
Set SV = Sheets("VERİ")
If WorksheetFunction.CountA(SV.[F2:F65536]) = 0 Then GoTo SON
SAY = Worksheets.Count
If SAY > 1 Then
For X = 2 To SAY
Application.DisplayAlerts = False
Sheets(2).Delete
Application.DisplayAlerts = True
Next X
End If
SV.[H:H].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=SV.[IV1], Unique:=True
For Y = 2 To SV.[IV65536].End(3).Row
Sheets.Add After:=Sheets(Worksheets.Count)
ActiveSheet.Name = SV.Cells(Y, "IV")
SATIR = 1
For Z = 2 To SV.[F65536].End(3).Row
If ActiveSheet.Name = UCase(Replace(Replace(SV.Cells(Z, "H"), "i", "İ"), "ı", "I")) Then
SATIR = SATIR + 1
Range("M1:R1") = SV.[F1:K1].Value
Range("M1:R1").HorizontalAlignment = xlCenter
Range("M1:R1").Font.Bold = True
Cells.EntireColumn.AutoFit
Cells(SATIR, "M") = SV.Cells(Z, "F")
Cells(SATIR, "N") = SV.Cells(Z, "G")
Cells(SATIR, "O") = SV.Cells(Z, "H")
Cells(SATIR, "P") = SV.Cells(Z, "I")
Cells(SATIR, "Q") = SV.Cells(Z, "J")
Cells(SATIR, "R") = SV.Cells(Z, "K")
End If
Next Z
Next Y
SV.Select
Application.ScreenUpdating = True
MsgBox "AKTARMA İŞLEMİ TAMAMLANMIŞTIR.", vbInformation
Exit Sub
SON:
MsgBox "AKTARILACAK KAYIT BULUNAMAMIŞTIR.", vbExclamation
Application.ScreenUpdating = True
End Sub