Makro Kod Yardım

[Uzunkol]

merhaba bu kodu çalışma kitabındaki tüm sayfalara uygulama şansımız varmı

Sub Duzenle()

Dim sut As Byte, i As Long, c As Range, Adr As Variant

Application.ScreenUpdating = False

Range("E:E").ClearContents
Range("F2:Q" & Rows.Count).ClearContents

Columns("B:B").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("E1"), Unique:=True

For i = 2 To Cells(Rows.Count, "E").End(xlUp).Row
sut = 6
With Range("B:B")
Set c = .Find(Cells(i, "E"), , xlValues, xlWhole)
If Not c Is Nothing Then
Adr = c.Address
Do
Cells(i, sut + Cells(c.Row, "C") - 1) = Cells(c.Row, "D")
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If
End With
Next i
Application.ScreenUpdating = True

End Sub

 

[Huseyinkis]

merhaba bu kodu çalışma kitabındaki tüm sayfalara uygulama şansımız varmı

Ekteki gibi denermisiniz.

Sub Duzenle()
Dim sut As Byte, i As Long, c As Range, Adr As Variant
Application.ScreenUpdating = False

For x1 = 1 To Sheets.Count

Sheets(x1).Select
Range("E:E").ClearContents
Range("F2:Q" & Rows.Count).ClearContents

Columns("B:B").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("E1"), Unique:=True

For i = 2 To Cells(Rows.Count, "E").End(xlUp).Row
sut = 6
With Range("B:B")
Set c = .Find(Cells(i, "E"), , xlValues, xlWhole)
If Not c Is Nothing Then
Adr = c.Address
Do
Cells(i, sut + Cells(c.Row, "C") - 1) = Cells(c.Row, "D")
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If
End With
Next i

Cells(2,"G")="Ocak"
Cells(2,"H")="Şubat"
Cells(2,"I")="Mart"
Cells(2,"J")="Nisan"
Cells(2,"K")="Mayıs"
Cells(2,"L")="Haziran"
Cells(2,"M")="Temmuz"
Cells(2,"N")="Ağustos"
Cells(2,"O")="Eylül"
Cells(2,"P")="Ekim"
Cells(2,"Q")="Kasım"
Cells(2,"R")="Aralık"

Next x1






Application.ScreenUpdating = True

End Sub

 

[Uzunkol]

Çok teşekkür ederim istediğim gibi olmuş ancak kodu şu şekilde düzenleyebilir miyiz. örnek gönderdim oradaki gibi ayları da yazabilir miyiz yardımcı olursanız çok sevinirim

 

[Uzunkol]

Lütfen yardımcı olur musunuz

 

[Uzunkol]

Sorun Çözüldü