hata hakkında yardım (1004)

[mustafa038]

merhabalar;


kaydettiğim makroyu uygularken aşağıdaki hatayı almaktayım. yardımlar için şimdiden teşekkürler.
(altı çizgili olan satırda mı hata var acaba ?)

dosya eklenmiştir.

Sub Makro1()
'
' Makro1 Makro
'

'
Columns("A:A").ColumnWidth = 5.14
Range("MyGrid[[#Headers],[Program No]]").Select
ActiveCell.FormulaR1C1 = "No"
Cells.Select
ActiveSheet.ListObjects("MyGrid").TableStyle = "TableStyleLight8"
Range("MyGrid").Select
Range("D15").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("C6").Select
Columns("B:B").ColumnWidth = 17
Range("C6").Select
Columns("C:C").ColumnWidth = 65
Columns("D").ColumnWidth = 5
Columns("D").Select
Selection.Replace What:="adet", Replacement:="Ad.", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("E:E").Select
Selection.ColumnWidth = 6.57
Cells.Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
Range("C6").Select
Columns("F:F").ColumnWidth = 7.29
Columns("G:G").ColumnWidth = 6.86
Columns("G:J").Select
Selection.NumberFormat = "#,##0.0"
Selection.NumberFormat = "#,##0"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.ColumnWidth = 25
Selection.ColumnWidth = 10
Selection.ColumnWidth = 8
Range("J18").Select
ActiveWindow.View = xlPageBreakPreview
Range("R15").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$J$171"
Range("O26").Select
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
Range("G21").Select
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "MyGrid[[#Tümü];[No]:[Sağlam miktar]]"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 70
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Range("B2").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=EĞERSAY($C2:$F2;""*KRM*"")+EĞERSAY($C2:$F2;""*POLİSAJ*"")+EĞERSAY($C2:$F2;""*KROM*"")>0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13395711
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("B2").Select
Selection.Copy
Columns("B:B").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("C7").Select
ActiveWorkbook.Worksheets("Sayfa1").ListObjects("MyGrid").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sayfa1").ListObjects("MyGrid").Sort.SortFields.Add _
Key:=Range("MyGrid[[#All],[Madde kodu]]"), SortOn:=xlSortOnValues, Order _
:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sayfa1").ListObjects("MyGrid").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("Sayfa1").ListObjects("MyGrid").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sayfa1").ListObjects("MyGrid").Sort.SortFields.Add _
Key:=Range("MyGrid[[#All],[Madde kodu]]"), SortOn:=xlSortOnCellColor, _
Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sayfa1").ListObjects("MyGrid").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.Zoom = 100
Rows("1:1").RowHeight = 23.25
Range("MyGrid[[#Headers],[Adı]]").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
Range("P2").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("MyGrid[[#Headers],[Adı]]").Select
ActiveCell.FormulaR1C1 = "=P2"
Range("P2").Select
Selection.Copy
Range("MyGrid[[#Headers],[=P2]]").Select
ActiveSheet.Paste
Range("MyGrid[[#Headers],[24.1.2018]]").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1/24/2018"
Range("MyGrid[[#Headers],[24.1.2018]]").Select
Selection.NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
Range("MyGrid[[#Headers],[24.1.2018]]").Select
ActiveCell.FormulaR1C1 = "1/24/2018"
Range("MyGrid[[#Headers],[24 Ocak 2018 Çarşamba]]").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("MyGrid[[#Headers],[24 Ocak 2018 Çarşamba]]").Select
ActiveCell.FormulaR1C1 = "24 Ocak 2018 Çarşamba"
Range("C7").Select
ChDir "C:\Users\ofis3.FLEKSSIT\Desktop"
Range("MyGrid[[#Headers],[24 Ocak 2018 Çarşamba]]").Select
ActiveCell.FormulaR1C1 = "24 Ocak 2018 Çarşamba"
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\ofis3.FLEKSSIT\Desktop\24 Ocak 2018 Çarşamba.xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Application.Dialogs(xlDialogSendMail).Show
ActiveWindow.SmallScroll Down:=-30
End Sub

 

[askm]

Dosyanızı ekleyip de yapmak istediğinizi yazsanız daha kolay olacak. Makro kaydet ile yaptığınız için çok karışık ve gereksiz kodlar oluşuyor.

 

[mustafa038]

Dosyanızı ekleyip de yapmak istediğinizi yazsanız daha kolay olacak. Makro kaydet ile yaptığınız için çok karışık ve gereksiz kodlar oluşuyor.

teşekkürler uyarınız için
dosya eklenmiştir.