• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro ile yeni sayfaya kopyalama-yapıştırma

yusuf1284' Alıntı:
Kod için teşekkür ederim kopyalama yapıyor fakat bu kopyalamada kopyalanan yerin biçmini almıyor sadece yazıları alıyor bire bir aynısını nasıl alabiliriz ?
Genişletmek için tıkla ...

Şöyle deneyin:

PHP: 
Sub sayfa_ekle_kopyala59()
Dim sh As Worksheet
Set sh = ActiveSheet
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Sayfa" & Sheets.Count
sh.Cells.Copy Range("A1")
Application.CutCopyMode = False
Range("A1").Select
MsgBox "Sayfa eklendi ve kopyalama yapıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub
 
yusuf1284' Alıntı:
Kod: 
Sub SAYFA_KOPYALA()
    Dim SAYFA_ADI As Variant

    SAYFA_ADI = Application.InputBox("sayfa adı giriniz.")

    If SAYFA_ADI = False Then
    MsgBox "İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    If SAYFA_ADI = "" Then
    MsgBox "Lütfen Sayfa adı giriniz. İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    Sheets("SABLON").Copy after:=Sheets(Sheets.Count)
 
    On Error Resume Next
    ActiveSheet.Name = SAYFA_ADI
    If Err = 1004 Then
    MsgBox "Aynı isimde sayfa bulunmaktadır. Eklenen son sayfa silinecektir.", vbCritical, "Dikkat !"
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True

    End If
 
End Sub

Bu kodda benzer sadece Sablon adındaki sayfayı kopyalıyor bana aktif sayfayı kopyalayan kod lazım
Genişletmek için tıkla ...


Bu da böyle:

PHP: 
Sub SAYFA_KOPYALA()
    Dim SAYFA_ADI As Variant

    SAYFA_ADI = Application.InputBox("sayfa adı giriniz.")

    If SAYFA_ADI = False Then
    MsgBox "İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    If SAYFA_ADI = "" Then
    MsgBox "Lütfen Sayfa adı giriniz. İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    ActiveSheet.Copy after:=Sheets(Sheets.Count)
 
    On Error Resume Next
    ActiveSheet.Name = SAYFA_ADI
    If Err = 1004 Then
    MsgBox "Aynı isimde sayfa bulunmaktadır. Eklenen son sayfa silinecektir.", vbCritical, "Dikkat !"
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
 
    End If
 
End Sub
 
@YUSUF44 ilgi alakanız için çok teşekkür ederim hocam bir de eklenen sayfanın adını sormadan direk o günün tarihini (örn: 05.04.2021) yapma imkanımız var mı?
 
Son makroda aşağıdaki kısmı değiştirip deneyin:

Eski hali:

SAYFA_ADI = Application.InputBox("sayfa adı giriniz.")

Yeni hali:

SAYFA_ADI = Format(Date,"dd.mm.yyyy")
 
YUSUF44' Alıntı:
Son makroda aşağıdaki kısmı değiştirip deneyin:

Eski hali:

SAYFA_ADI = Application.InputBox("sayfa adı giriniz.")

Yeni hali:

SAYFA_ADI = Format(Date,"dd.mm.yyyy")
Genişletmek için tıkla ...

Input varsayılan tarih yazılabilir mi aynı şekil.

SAYFA_ADI = Application.InputBox(Format(Date, "dd.mm.yyyy"))

Şunu denedim fakat olmadı :)

Çözdüm şu şekilde yaptım :D

SAYFA_ADI = Application.InputBox("Sayfa adını Giriniz.", "Tarih", Format(Date, "dd.mm.yyyy"))
 
Son düzenleme:
yusuf1284' Alıntı:
Kod: 
Sub SAYFA_KOPYALA()
    Dim SAYFA_ADI As Variant

    SAYFA_ADI = Application.InputBox("sayfa adı giriniz.")

    If SAYFA_ADI = False Then
    MsgBox "İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    If SAYFA_ADI = "" Then
    MsgBox "Lütfen Sayfa adı giriniz. İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    Sheets("SABLON").Copy after:=Sheets(Sheets.Count)
 
    On Error Resume Next
    ActiveSheet.Name = SAYFA_ADI
    If Err = 1004 Then
    MsgBox "Aynı isimde sayfa bulunmaktadır. Eklenen son sayfa silinecektir.", vbCritical, "Dikkat !"
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True

    End If
 
End Sub

Bu kodda benzer sadece Sablon adındaki sayfayı kopyalıyor bana aktif sayfayı kopyalayan kod lazım
Genişletmek için tıkla ...

Arkadaşlar buradaki kodlar çok işime yaradı, şöyle bir sorum olacak "Örnek Şablon" sayfamı gizli yapmak istiyorum(denedim) fakat oradan kopyalama yapmayıp son sayfanın adını değiştiriyor(bu arada gizli sekme içerisinde kopyala-yapıştır sayfalar oluşturuyor).

Özetle şablonu gizleyerek buradan kopyala yapıp yeni sayfa nasıl açtırırım ? şimdiden vereceğiniz cevaplar için teşekkürler..
 
Sheets("SABLON").Copy after:=Sheets(Sheets.Count)


Satırını aşağıdaki kodlarla değiştirip deneyin:

PHP: 
    With Sheets("SABLON")
        .Visible = True
        .Copy after:=Sheets(Sheets.Count)
        .Visible = False
    End With
 
YUSUF44' Alıntı:
Sheets("SABLON").Copy after:=Sheets(Sheets.Count)


Satırını aşağıdaki kodlarla değiştirip deneyin:

PHP: 
    With Sheets("SABLON")
        .Visible = True
        .Copy after:=Sheets(Sheets.Count)
        .Visible = False
    End With
Genişletmek için tıkla ...

Cevap için çok teşekkür ederim.
Dün en son şöyle bir sonuca ulaşmıştım tam gizleme ile yaptım fark olur mu bilmiyorum sanırım aynı işi görüyor. bu arada işlem için iptal dediğimde de hata veriyordu oraya da kodu ekledim.. belki birilerinin işine yarar diye aşağıya kodu ekledim.. Selamlarımla..

PHP: 
    Private Sub Yeni_Sayfa_Click()
    'Yeni_sayfa_aç_içeriği_kopyala
    Dim SAYFA_ADI As Variant
    Sheets("Örnek Şablon").Visible = True
    SAYFA_ADI = Application.InputBox("Sayfa adı giriniz.")

    If SAYFA_ADI = False Then
    MsgBox "İşleminiz iptal edilmiştir.", vbInformation
    Sheets("Örnek Şablon").Visible = xlSheetVeryHidden
    Exit Sub: End If

    If SAYFA_ADI = "" Then
    MsgBox "Lütfen Sayfa adı giriniz. İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    Sheets("Örnek Şablon").Copy after:=Sheets(Sheets.Count)
  
    On Error Resume Next
    ActiveSheet.Name = SAYFA_ADI
    If Err = 1004 Then
    MsgBox "Aynı isimde sayfa bulunmaktadır. Eklenen son sayfa silinecektir.", vbCritical, "Dikkat !"
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    End If
    Sheets("Örnek Şablon").Visible = xlSheetVeryHidden
End Sub
[/QUOTE]
 
yusuf1284' Alıntı:
Kod: 
Sub SAYFA_KOPYALA()
    Dim SAYFA_ADI As Variant

    SAYFA_ADI = Application.InputBox("sayfa adı giriniz.")

    If SAYFA_ADI = False Then
    MsgBox "İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    If SAYFA_ADI = "" Then
    MsgBox "Lütfen Sayfa adı giriniz. İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    Sheets("SABLON").Copy after:=Sheets(Sheets.Count)
 
    On Error Resume Next
    ActiveSheet.Name = SAYFA_ADI
    If Err = 1004 Then
    MsgBox "Aynı isimde sayfa bulunmaktadır. Eklenen son sayfa silinecektir.", vbCritical, "Dikkat !"
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True

    End If
 
End Sub

Bu kodda benzer sadece Sablon adındaki sayfayı kopyalıyor bana aktif sayfayı kopyalayan kod lazım
Genişletmek için tıkla ...




mrblar bana buna benzer bir kod lazımdı,,

aktif çalışma sayasındaki belirli bir aralığı (A1:Q33)
resim olarak yeni çalışma sayfasına aktaarmasını istiyorum

bu şekilde düzenleyebilir misinz acaba
 
Merhaba,

Deneyiniz.

C++: 
Option Explicit

Sub Range_To_Picture()
    Dim Rng As Range
    
    Set Rng = Sheets("Sheet1").Range("A1:Q33")
    
    Rng.CopyPicture xlScreen, xlPicture
    Sheets.Add
    ActiveSheet.Paste

    Set Rng = Nothing
End Sub
 
Korhan Ayhan' Alıntı:
Merhaba,

Deneyiniz.

C++: 
Option Explicit

Sub Range_To_Picture()
    Dim Rng As Range
   
    Set Rng = Sheets("Sheet1").Range("A1:Q33")
   
    Rng.CopyPicture xlScreen, xlPicture
    Sheets.Add
    ActiveSheet.Paste

    Set Rng = Nothing
End Sub
Genişletmek için tıkla ...

ÇOK TEŞEKKÜR EDERİM.

ŞÖYLE BİR ŞEY EKLEME İMKANINIZ VAR MIDIR ACABA
SAYFA 1 DEN (A1:AV110) VE SAYFA2 DEN (A1:AR110) ARASINI RESİM OLARAK KOPYALAYIP "YENİ BİR ÇALIŞMA SAYFASI" NDA YAN YANA YAPIŞTIRSIN

KISACASI İKİ FARKLI ÇALIŞMA SAYFASINDAKİ ARALIĞI YENİ BİR ÇALIŞMA SAYFASINA RESİM OLARAK KAYDETMESİNİ İSTİYORUM

TEŞEKKÜRLER ŞİMDİDEN
 
Neden mesajlarınızı BÜYÜK harfle yazıyorsunuz.. Özel bir nedeni var mı?
 
mrb lar, bi konuda yardıma ihtiyacım var , yardımcı olabilecek varsa sevinirim.

elimdeki makrunun
- 42.sutunda en dolu olan satırda işlem yapması (sonraki satır boş olduğunda durması)
-33.sutundaki dolu olan hücre için çalışması ( boş hucreye denk geldiğinde atlaması sonraki hücreye geçmesini)

istiyrum. aşağıdaki makroya yukardaki 2 işlemi eklemek istiyorum


,,



Sub commandbutton1_click()

ThisWorkbook.Activate
For i = 4 To 100
'dim ie as internetexplorer
Dim number As String
Dim mytext As String
Dim sh As Worksheet
'set ie = new internetexplorer
Set sh = Sheets("nöbet listesi")
sh.Activate

Cells(i, 42).Copy
Range("Y2").Select
ActiveSheet.Paste

sh.Range("D1:Q32").Select
Selection.CopyPicture appearance:=xlScreen, Format:=xlPicture
Application.Wait (Now + TimeValue("00:00:02"))
Range("D170").Select
ActiveSheet.Paste
Selection.ShapeRange.Name = "picture 1"
sh.Shapes("picture 1").Copy

ActiveWorkbook.FollowHyperlink Address:="https://web.whatsapp.com/send?phone=" & Cells(i, 33) & "&Text=" & Cells(i, 43)
Application.Wait (Now + TimeValue("00:00:15"))
Call SendKeys("^v")
Application.Wait (Now + TimeValue("00:00:02"))
Call SendKeys("~", True)
Application.Wait (Now + TimeValue("00:00:05"))
Call SendKeys("^+W")
Application.Wait (Now + TimeValue("00:00:05"))
ActiveSheet.Shapes("picture 1").Delete

Next i

End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst