sayfa kopyalama

[ordulu82]

Merhaba,
Mevcut kodlarınızda aşağıda belirttiğim satırların arasına kırmızı ile işaretlediğim satırı ekleyip dener misiniz?

vbYesNo + vbQuestion, "U Y A R I   !!!!") = vbNo Then Exit Sub
[COLOR="Red"] Sheets(i).UsedRange.Clear[/COLOR]            
Windows("Kitap1.xlsm").Activate

Üstadım yine satır kaydırıyor. mesela benim veriler c5 den başlıyor. fakat kopyalanan sayfaya bakıyorum c5 deki satırı a1 e almış. fakat bu sorun sadece sayfa değiştirirken oluyor. sayfayı ilk defa yedeklerken sorun olmuyor.

 

[dEdE]

Merhaba,
Önceki kodları unutalım.
Aşağıdaki kodu dener misiniz?

Sub Kopyala()
sAdı = ThisWorkbook.ActiveSheet.Name
Application.ScreenUpdating = False
Workbooks.Open ThisWorkbook.Path & "\" & "Kitap2.xlsx"
For i = 1 To Sheets.Count
    If Sheets(i).Name = sAdı Then
        If MsgBox(Sheets(i).Name & "  İsimli Sayfa Var." & vbCrLf & " Yine de Aktarmak İstiyor musunuz?", _
        vbYesNo + vbQuestion, "U Y A R I   !!!!") = vbNo Then Exit Sub
        Application.DisplayAlerts = False
        Sheets(i).Delete
        Application.DisplayAlerts = True
        Exit For
    End If
Next
    Workbooks("Kitap1.xlsm").ActiveSheet.Copy Before:=Workbooks("Kitap2.xlsx").Sheets(1)
    ActiveSheet.Cells.Copy
    ActiveSheet.Cells.PasteSpecial xlPasteValues
    [A1].Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamam...", vbInformation, "dEdE Başarılar Diler..."
End Sub

 

[ordulu82]

Merhaba,
Önceki kodları unutalım.
Aşağıdaki kodu dener misiniz?

Sub Kopyala()
sAdı = ThisWorkbook.ActiveSheet.Name
Application.ScreenUpdating = False
Workbooks.Open ThisWorkbook.Path & "\" & "Kitap2.xlsx"
For i = 1 To Sheets.Count
    If Sheets(i).Name = sAdı Then
        If MsgBox(Sheets(i).Name & "  İsimli Sayfa Var." & vbCrLf & " Yine de Aktarmak İstiyor musunuz?", _
        vbYesNo + vbQuestion, "U Y A R I   !!!!") = vbNo Then Exit Sub
        Application.DisplayAlerts = False
        Sheets(i).Delete
        Application.DisplayAlerts = True
        Exit For
    End If
Next
    Workbooks("Kitap1.xlsm").ActiveSheet.Copy Before:=Workbooks("Kitap2.xlsx").Sheets(1)
    ActiveSheet.Cells.Copy
    ActiveSheet.Cells.PasteSpecial xlPasteValues
    [A1].Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamam...", vbInformation, "dEdE Başarılar Diler..."
End Sub

Üstadım eline sağlık, çok teşekkür ederim.