Sayfalara ayır

Katılım
14 Haziran 2006
Mesajlar
575
Altın Üyelik Bitiş Tarihi
10.04.2023
Merhaba
Rapor sayfasındaki verileri sayfalara ayırmak istiyorum.
H sutünundaki veriye göre sayfalar açacak.
H sutünundaki veriye göre açılan sayfalara E ve N sutünundaki veriler dağıtaçak
Macro ile yapabilirmiyiz.
Teşekkürler.
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,731
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Aşağıdaki kodu denermisiniz. Kod "E" sütununu yeni sayfada "A" sütununa, "N" sütununuda "B" sütununa aktarmaktadır. Farklı sütunlara aktarmak isterseniz kırmızı bölümleri değiştiriniz.

Kod:
Option Explicit
 
Sub SAYFALARA_AKTAR()
    Dim Sayfa As Worksheet, SR As Worksheet
    Dim X As Long, Satır As Long
 
    Set SR = Sheets("Rapor")
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    For Each Sayfa In ThisWorkbook.Worksheets
        If Sayfa.Name <> "Rapor" Then Sayfa.Delete
    Next
 
    Application.DisplayAlerts = True
 
    For X = 12 To SR.Range("E65536").End(3).Row
        Sheets.Add , After:=Sheets(Worksheets.Count)
        ActiveSheet.Name = SR.Cells(X, "H")
        Satır = SR.Cells(X, "H").End(4).Row
        If Satır = 65536 Then Satır = SR.Range("E65536").End(3).Row + 2
        SR.Range("E" & X + 2 & ":E" & Satır - 2).Copy Sheets("" & SR.Cells(X, "H")).Range("[COLOR=red]A[/COLOR]1")
        SR.Range("N" & X + 2 & ":N" & Satır - 2).Copy Sheets("" & SR.Cells(X, "H")).Range("[COLOR=red]B[/COLOR]1")
        X = Satır - 1
    Next
 
    SR.Select
    Set SR = Nothing
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Katılım
14 Haziran 2006
Mesajlar
575
Altın Üyelik Bitiş Tarihi
10.04.2023
Korhan bey
Yine exceli döktürmüşsün.
Yardımın için teşekkür ederim,güzel çalışıyor iyi bir kod oldu.
 
Üst