Çalışma kitabındaki a1 ve b1 hücreleri kopyalama

[levo26]

Merhaba,

120 safyadan oluşan çalşıma kitabımda a1 ve b1 hücrelerindeki bilgileri boş bir excele satırlara yapıştırmak istiyorum.

 

[levo26]

Arkadaşlar,

Örnek çalışma ektedir.

 

[Orion1]

Dosyanız ektedir.

Sub aktar59()
Dim sat As Long, sh As Worksheet
Sheets("icmal").Select
Range("A:B").ClearContents
Application.ScreenUpdating = False
For Each sh In Worksheets
    If sh.Name <> "icmal" Then
        sat = sat + 1
        Cells(sat, "A").Value = sh.Cells(1, "A").Value
        Cells(sat, "B").Value = sh.Cells(1, "B").Value
    End If
Next sh
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır." & vbLf & "evrengizlen@hotmail.com", _
        vbOKOnly + vbInformation, Application.UserName

End Sub

 

[levo26]

Çok Teşekkür ederim. İstediğim sonucu aldım. Sağolun.