- Katılım
- 8 Mart 2006
- Mesajlar
- 317
- Excel Vers. ve Dili
- EXCEL-2013
- Altın Üyelik Bitiş Tarihi
- 18-05-2024
Değerli arkadaşlar bir cari hesap dosyamda standart şekilde açılmış hesap sayfalarının Özetini (MİZAN) makro tuşu ile aldırıyorum fakat özet listede cari hesap işlemi olmayan sayfaların isminide sıralıyor oysa sadece cari hasep sayfaları görünmesi gerekir bu konuda yardımcı olurmusunuz... Saygılar
mizan aktarma için kullandığım makro aşağıdaki gibidir
Sub MİZAN()
Application.ScreenUpdating = False
Set SM = Sheets("MİZAN")
SM.[A6:F65536].Clear
For X = 1 To Worksheets.Count - 1
[A65536].End(3).Select
If ActiveCell.Address = "$A$5" Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 1
Else
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
End If
SM.Select
ActiveCell.Offset(0, 1) = Sheets(X).Name
ActiveCell.Offset(0, 2) = Sheets(X).[F3]
ActiveCell.Offset(0, 3) = Sheets(X).[F2]
If ActiveCell.Offset(0, 2) > ActiveCell.Offset(0, 3) Then
ActiveCell.Offset(0, 4) = (ActiveCell.Offset(0, 2) - ActiveCell.Offset(0, 3))
ActiveCell.Offset(0, 4).Font.Bold = True
ActiveCell.Offset(0, 5) = ""
End If
If ActiveCell.Offset(0, 3) > ActiveCell.Offset(0, 2) Then
ActiveCell.Offset(0, 5) = (ActiveCell.Offset(0, 3) - ActiveCell.Offset(0, 2))
ActiveCell.Offset(0, 5).Font.Bold = True
ActiveCell.Offset(0, 4) = ""
End If
Next
[C6:F65536].NumberFormat = "#,##0.00"
[B6:F65536].Sort Key1:=[B6], Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
[A5:F5].Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
[B3].Select
Application.ScreenUpdating = True
MsgBox "MİZAN BAŞARIYLA OLUŞTURULMUŞTUR...", vbInformation
End Sub
mizan aktarma için kullandığım makro aşağıdaki gibidir
Sub MİZAN()
Application.ScreenUpdating = False
Set SM = Sheets("MİZAN")
SM.[A6:F65536].Clear
For X = 1 To Worksheets.Count - 1
[A65536].End(3).Select
If ActiveCell.Address = "$A$5" Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = 1
Else
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
End If
SM.Select
ActiveCell.Offset(0, 1) = Sheets(X).Name
ActiveCell.Offset(0, 2) = Sheets(X).[F3]
ActiveCell.Offset(0, 3) = Sheets(X).[F2]
If ActiveCell.Offset(0, 2) > ActiveCell.Offset(0, 3) Then
ActiveCell.Offset(0, 4) = (ActiveCell.Offset(0, 2) - ActiveCell.Offset(0, 3))
ActiveCell.Offset(0, 4).Font.Bold = True
ActiveCell.Offset(0, 5) = ""
End If
If ActiveCell.Offset(0, 3) > ActiveCell.Offset(0, 2) Then
ActiveCell.Offset(0, 5) = (ActiveCell.Offset(0, 3) - ActiveCell.Offset(0, 2))
ActiveCell.Offset(0, 5).Font.Bold = True
ActiveCell.Offset(0, 4) = ""
End If
Next
[C6:F65536].NumberFormat = "#,##0.00"
[B6:F65536].Sort Key1:=[B6], Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
[A5:F5].Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
[B3].Select
Application.ScreenUpdating = True
MsgBox "MİZAN BAŞARIYLA OLUŞTURULMUŞTUR...", vbInformation
End Sub