Sub SayfaAktar()
Dim syf As Worksheet
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("Depo")
.Range("A2" & Rows.Count).ClearContents
For Each syf In ThisWorkbook.Sheets
If LCase(syf.Name) <> "depo" Then
If WorksheetFunction.CountA(syf.Range("A2" & Rows.Count)) > 0 Then
syf.Range("A2" & syf.Range("A" & Rows.Count).End(3).Row).Copy
.Range("A" & Rows.Count).End(3)(2, 1).PasteSpecial xlPasteValuesAndNumberFormats
End If
End If
Next
End With
MsgBox "islem tamam...", vbInformation, "Bilgi"
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Yada en iyisi bu.Aktarırken format olarakta aktarır.