DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Süz()
Application.ScreenUpdating = False
Dim y As Byte
Dim son, son1, i As Integer
On Error Resume Next
son = Range("D1000").End(3).Row
Range("P4" & son) = "=IF(COUNTIF(D$4
4,D4)=1,D4,"""")"
Range("P4" & son) = Range("P4
" & son).Value
son = Range("P1000").End(3).Row
Range("P4" & son).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
son = Range("P1000").End(3).Row
For i = 4 To son
Range("B5").AutoFilter Field:=3, Criteria1:=Cells(i, 16)
son1 = Range("D1000").End(3).Row
For y = 3 To Sheets.Count
If Sheets.Name = Cells(i, 16).Text Then
Sheets(Cells(i, 16).Text).Range("B4:M1000") = ""
Range("B4:M" & son1).Copy Sheets(Cells(i, 16).Text).Range("B4")
GoTo 10
End If
Next y
Sheets("Şablon").Copy After:=Sheets(Sheets.Count)
Sheets("FATURALAR").Range("B4:M" & son1).Copy Range("B4")
Sheets("FATURALAR").Range("B5").AutoFilter
ActiveSheet.Name = Sheets("FATURALAR").Cells(i, 16).Value
Sheets("FATURALAR").Select
10
Next i
Sheets("FATURALAR").Range("B5").AutoFilter
Range("P") = ""
End Sub
merhaba,
formüllerle çözümlenmiş dosyanız ektedir... Eğer satır sayınız çok fazla ise makro lu çözüm daha kullanışlı oacaktır..
kolay gelsin...
Ben de bir tane makrolu hazırladım.