Sadece Dolu Hücreleri Kopyalamak!!!

[shenko]

Aşağıdaki makroda; b7:s500 den an7 ye veriler kopyalanıyor.

Bunu sadece dolu hücreleri kopyala şeklinde değiştirmek mümkünmü?

Birde kopyalama işlemini yaparken formülleri kopyalamasını engelleyebilirmiyiz?

Sub Macro2()

ActiveWindow.SmallScroll ToRight:=-37
Range("AN7:BE500").Select
Selection.ClearContents
ActiveWindow.LargeScroll ToRight:=-21
Range("b7:S500").Copy Range("AN7")
Application.CutCopyMode = False
Selection.Sort Key1:=Range("AO7"), Order1:=xlAscending, Key2:=Range("AN7") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Range("AM2").Select
son = [AM65536].End(3).Row
Range("AM7:BE" & son).Select
Selection.Font.Name = "Arial"
Selection.Sort Key1:=Range("AO7"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Cells(7, 41).Font.Name = "Arial Black"
For x = 7 To son - 1
If Cells(x, 41) <> Cells(x + 1, 41) Then Cells(x + 1, 41).Font.Name = "Arial Black"
Next
son = [AO65536].End(3).Row
For x = 7 To son
If Range("AO" & x).Font.Name = "Arial Black" Then
Range("AM" & x - 1 & ":BE" & x - 1).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If

Next
MsgBox "SATICILAR'A GÖRE SIRALANDI!"
End Sub

 

[Levent Menteşoğlu]

Range("b7:S500").Copy Range("AN7")

Yukarıdaki satırı aşağıdaki gibi değiştirin.

Range("b7:S500").Copy
Range("AN7").PasteSpecial xlPasteValues

Birde kodlarınız içindeki activewindow ile başlayan gereksiz satırları kaldırın.