Sayfa Kopyala

[sedat2161]

Merhaba arkadaşlar. Ekli dosyamda liste sayfasındaki butona tıkladığımda sayfa bilgilerini yeni sayfa adı ile kopyalama yapıyorum. Benim isteğim butona tıkladığımda sayfa aralığı seçerek yeni sayfa açarak kopyalanması. Örneğin A3:F18 arası.

 

[çıtır]

Aşağıdaki kodu deneyiniz.

Private Sub CommandButton1_Click()
    Dim i As Integer
    If Worksheets("LİSTE").Range("h2").Value = "" Then Exit Sub
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = Worksheets("LİSTE").Range("H2").Value & "" Then
            MsgBox "Bu isimde bir sayfa bulundu"
        Exit Sub
        End If
    Next i
    Worksheets("LİSTE").Range("A3:G18").Select
    Selection.Copy
        Ad = Sheets(Worksheets.Count).Name
        Sheets.Add After:=Sheets(Worksheets.Count)
        ActiveSheet.Name = Worksheets("LİSTE").Range("H2").Value & ""
    ActiveSheet.Range("A3").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
End Sub

 

[kulomer46]

Merhaba

Farklı bir alternatif olarak aşağıdaki Makro Kodunuda deneyiniz.

Sub Sadece_Seçili_Alanı_Yeni_Sayfaya_Yapıştır()
'31.12.2019    14:27

    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste

    Cells.EntireColumn.AutoFit
    Application.CutCopyMode = False
    Range("A1").Select
   
End Sub

Selamlar...

 

[sedat2161]

Merhaba

Farklı bir alternatif olarak aşağıdaki Makro Kodunuda deneyiniz.

Sub Sadece_Seçili_Alanı_Yeni_Sayfaya_Yapıştır()
'31.12.2019    14:27

    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste

    Cells.EntireColumn.AutoFit
    Application.CutCopyMode = False
    Range("A1").Select
  
End Sub

Selamlar...

Teşekkür ederim

Aşağıdaki kodu deneyiniz.

Private Sub CommandButton1_Click()
    Dim i As Integer
    If Worksheets("LİSTE").Range("h2").Value = "" Then Exit Sub
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = Worksheets("LİSTE").Range("H2").Value & "" Then
            MsgBox "Bu isimde bir sayfa bulundu"
        Exit Sub
        End If
    Next i
    Worksheets("LİSTE").Range("A3:G18").Select
    Selection.Copy
        Ad = Sheets(Worksheets.Count).Name
        Sheets.Add After:=Sheets(Worksheets.Count)
        ActiveSheet.Name = Worksheets("LİSTE").Range("H2").Value & ""
    ActiveSheet.Range("A3").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
End Sub

Selamlar. İlginiz için teşekkür ederim.
Sayın Çıtır bey ilginiz için teşekkür ederim. Sayfa aktardığımda hücre genişliği farklı geliyor. bir yolu var mı acaba.