Excelde makro ile yan yana olan hücreleri alt alt kopyalama yapma

cengizyener

Altın Üye
Katılım
10 Kasım 2022
Mesajlar
30
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
10-11-2028
Arkadaşlar Merhabalar,

Elimde bir excel dosyası var dosyayı açtığınızda dosyada 2 buton var biri Mavi ve Kırmızı diye 2 buton var. Maviye tıkladığımda B6:E6 hücresini kopyalıyor bende hafızada olan bu veriyi başka bir dosyaya kopyalıyorum daha sonra Kırmızıya tıklıyorum bu defa F6:I6 hücresini kopyalıyor Maviden kopyaladığım excel tablosunun altına yapıştırıyor benim yapmak istediğim tek butonla B6:E6 sanki F6:I6 alt altaymış gibi kopyalayıp diğer tabloya yapıştır dediğimde dosyadaki N13:Q13 ne N14:Q14 e yapıştıracak şekilde hafızaya almak istiyorum. Bu konuda yardımcı olursanız sevinirim.

Özetle istediğim

Kırmızı Kopyalama
B6:E6

Mavi Kopyalama
F6:I6

Mavi +
Kırmızı

B6:E6
F6:I6
 

Ekli dosyalar

tugkan

Altın Üye
Katılım
6 Kasım 2004
Mesajlar
481
Excel Vers. ve Dili
Excel 2016
Türkçe 64 BIT
Altın Üyelik Bitiş Tarihi
16-10-2025
verilerinizin yerleri sabit mi? Yani dosyanızdaki gibi mi her zaman yoksa değişebiliyor mu?
 

cengizyener

Altın Üye
Katılım
10 Kasım 2022
Mesajlar
30
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
10-11-2028
sütun ve satır olarak sabitler. yani ben satıra sadece tıklıyorum ilgili satırda B*:E* ve F*:I* kopyalamak istiyorum
 

cengizyener

Altın Üye
Katılım
10 Kasım 2022
Mesajlar
30
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
10-11-2028
yapıştırmayı ben yapmalıyım. dosyada sadece kopyalama yapması yeterli
 

cengizyener

Altın Üye
Katılım
10 Kasım 2022
Mesajlar
30
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
10-11-2028
Trilenium Hocam,

Geri dönüşünüz için çok teşekkür ederim emeğinize sağlık bu şekilde işimi görüyor :)
 

Trilenium

Destek Ekibi
Destek Ekibi
Katılım
16 Eylül 2008
Mesajlar
1,291
Excel Vers. ve Dili
Microsoft Office 2019 English
Rica ederim.

Çalışma mantığı şu şekilde ilerlemektedir.

Temp bir sayfaya veriler aktarılıyor ve kopyalanıyor, ta ki siz yapıştırana kadar yapıştırılmayı bekliyor.

Seçim aralıkları ile ilgili şeyleri parametrik yapabilirsiniz.

kolay gelsin
 

cengizyener

Altın Üye
Katılım
10 Kasım 2022
Mesajlar
30
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
10-11-2028
Trilenium Hocam Günaydın,

Hocam tam olarak bunu istedim. Önemli olan B6:E6 F6:I6 hücrelerinin alt alta gelmesi ve bunları en kısa sürede işlemi tamamlamasıydı başka bir sayfadan alması falan sorun değil. Orjinal dosyada kullanırken bazı değişiklikler yapmak zorunda kaldım çünkü değişiklikler yapmamın sebebi de şu, sizleri anlamsız bilgilerle yormayıp nokta atışı sadece sorunu anlamanız bazı anlamsız bilgileri vermedim. Orjinalde kullanınca aktarımda sorun yaşadım ve bunun içinde bazı değişiklikler yaptım. temp sayfasına aktardığımız veriler başka kolona bağlı olduğu için bunu değerleri yapıştır yaptım birde ana sayfaya gitmesi için koda ekleme yaptım. temp sayfasını gizlemeye gerek olmadığı için temp dosyası görünür bıraktım. Yapmaya çalıştığım şey zaman kazanmak 600 700 defa kopyalamayı kullanacağım emeklerinizden dolay çok teşekkür ederim. Aşağıdaki gibi bir kaç değişiklikler yaptım sizce iyi olmuş mu ?



Kod:
Sub baslat()
Dim ws As Worksheet
    Dim tempWs As Worksheet
    Dim sourceRange1 As Range
    Dim sourceRange2 As Range
    Dim tempRange As Range

    ActiveCell.Select
    Sec = ActiveCell.Row

    Set ws = ThisWorkbook.Sheets("Ekstre") ' Kendi sayfanızın adını buraya yazın

    On Error Resume Next
    Set tempWs = ThisWorkbook.Sheets("temp")
    On Error GoTo 0

    If tempWs Is Nothing Then
    Set tempWs = ThisWorkbook.Sheets.Add
    tempWs.Name = "temp"
    Else
    tempWs.Cells.Clear
    End If

    Set sourceRange1 = ws.Range("AN" & Sec, "AU" & Sec)
    sourceRange1.Copy
    Sheets("temp").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


    Set sourceRange2 = ws.Range("AX" & Sec, "BE" & Sec)
    sourceRange2.Copy
    Sheets("temp").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Set tempRange = tempWs.Range("A1:H2")

    tempRange.Copy
   
    'MsgBox "Veriler kopyalandı. Şimdi istediğiniz yere yapıştırabilirsiniz.", vbInformation

   'Application.DisplayAlerts = False
   'tempWs.Visible = xlSheetHidden
   ' Application.DisplayAlerts = True

    Sheets("Ekstre").Select
    Range("AL" & Sec).Select
End Sub
 

Trilenium

Destek Ekibi
Destek Ekibi
Katılım
16 Eylül 2008
Mesajlar
1,291
Excel Vers. ve Dili
Microsoft Office 2019 English
Gayet güzel olmuş,ellerinize sağlık.

Bir japon atasözü vardır "Çalışıyorsa kurcalama" diye, işinizi gördüğü sürece her şey güzeldir.
 

cengizyener

Altın Üye
Katılım
10 Kasım 2022
Mesajlar
30
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
10-11-2028
Trilenium Hoca Merhabalar,
O zaman hiç kurcalamayayım hocam bu şekilde sorunsuz bir şekilde çalıştı o zaman kullanmaya devam edeyim :) İyi günler dilerim Hocam :)
 
Üst