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

YUSUF44 · 4 Nisan 2021

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 ?

Şö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

YUSUF44 · 4 Nisan 2021

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

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

yusuf1284 · 5 Nisan 2021

@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ı?

YUSUF44 · 5 Nisan 2021

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")

yusuf1284 · 5 Nisan 2021

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")

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

SAYFA_ADI = Application.InputBox("Sayfa adını Giriniz.", "Tarih", Format(Date, "dd.mm.yyyy"))

izistanbul · 30 Ocak 2022

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

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..

YUSUF44 · 31 Ocak 2022

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

izistanbul · 31 Ocak 2022

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

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]

ahmettaskin · 16 Haziran 2023

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

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

Korhan Ayhan · 17 Haziran 2023

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

ahmettaskin · 24 Temmuz 2023

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

Ç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

Korhan Ayhan · 26 Temmuz 2023

Neden mesajlarınızı BÜYÜK harfle yazıyorsunuz.. Özel bir nedeni var mı?

ahmettaskin · 3 Ağustos 2023

Korhan Ayhan' Alıntı:
Neden mesajlarınızı BÜYÜK harfle yazıyorsunuz.. Özel bir nedeni var mı?

özel bir nedeni yok , yazdığım sırada capslook açıkmış fark etmedim çok büyük küçük harf ayrıntısını . büyük harfle yazmanın sorun olduğunu da bilmiyordum kusura bakmayın .

ahmettaskin · 6 Mayıs 2024

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

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

YUSUF44

Destek Ekibi

YUSUF44

Destek Ekibi

yusuf1284

YUSUF44

Destek Ekibi

yusuf1284

izistanbul

YUSUF44

Destek Ekibi

izistanbul

ahmettaskin

Korhan Ayhan

Administrator

ahmettaskin

Korhan Ayhan

Administrator

ahmettaskin

ahmettaskin