Bir sayfadan diğer sayfaya sütunları kopyalama

hakki83

Altın Üye
Katılım
30 Eylül 2021
Mesajlar
546
Excel Vers. ve Dili
Excel 2016 Türkçe 32 Bit
Altın Üyelik Bitiş Tarihi
30-09-2026
Değerli hocalarımız iyi günler

Örnek dosyadaki İlk sayfanın A sütununu,
İkinci sayfadaki A sütununa;

İlk sayfanın SONUÇLAR başlıklı son sütununu,
İkinci sayfadaki B sütununa kopyalayacak kodu rica ederim.

Son sütunun yeri sabit değildir, değişkendir.

Detaylı açıklamayı dosya içine de yazdım.

Teşekkürler.
 

Ekli dosyalar

Katılım
9 Eylül 2010
Mesajlar
868
Excel Vers. ve Dili
2016&2019&2021 TR
Altın Üyelik Bitiş Tarihi
29-09-2023
Ekstra talepler yoksa. Bunu makro kaydet ile çözebilirsiniz hocam. Bir deneyin isterseniz.
 

hakki83

Altın Üye
Katılım
30 Eylül 2021
Mesajlar
546
Excel Vers. ve Dili
Excel 2016 Türkçe 32 Bit
Altın Üyelik Bitiş Tarihi
30-09-2026
Şu an bilgisayar başında değilim. Son sütunun yeri değişken, yani hep aynı yerde değil.
Eğer bu şekilde makro kaydet yöntemiyle doğru kod bulunacaksa, tabi denerim.
 

dEdE

Destek Ekibi
Destek Ekibi
Katılım
1 Temmuz 2005
Mesajlar
2,605
Excel Vers. ve Dili
Ofis 2013 TR 64 Bit
Merhaba,
Aşağıdaki kodu dener misiniz?
Kod:
Private Sub CommandButton1_Click()
    Set ws1 = Sheets("VERİ SAYFASI")
    ss = ws1.Cells(Rows.Count, "A").End(xlUp).Row
    sk = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
    
    ws1.Columns("A:A").Copy Sheets("RAPOR SAYFASI").Columns("A:A")
    ws1.Range(ws1.Cells(1, sk), ws1.Cells(ss, sk)).Copy Sheets("RAPOR SAYFASI").Range("B1")
End Sub
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,253
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Alternatif;

C++:
Option Explicit

Private Sub CommandButton1_Click()
    Dim S1 As Worksheet, S2 As Worksheet, Bul As Range, Son As Long
    
    Set S1 = Sheets("RAPOR SAYFASI")
    Set S2 = Sheets("VERİ SAYFASI")
    
    Son = S2.Cells(S2.Rows.Count, 1).End(3).Row
    
    With S1
        .Range("A:B").Clear
        .Range("A1:A" & Son).Value = S2.Range("A1:A" & Son).Value
        Set Bul = S2.Rows(1).Find("SONUÇLAR", LookAt:=xlWhole)
        If Not Bul Is Nothing Then
            .Range("B1:B" & Son).Value = Bul.Resize(Son).Value
        End If
    End With
    
    Set Bul = Nothing
    Set S1 = Nothing
    Set S2 = Nothing

    MsgBox "Veri aktarımı tamamlanmıştır.", vbInformation
End Sub
 

hakki83

Altın Üye
Katılım
30 Eylül 2021
Mesajlar
546
Excel Vers. ve Dili
Excel 2016 Türkçe 32 Bit
Altın Üyelik Bitiş Tarihi
30-09-2026
Dede hocam ve Korhan hocalarımızın kodları tam doğrudur. Emeklerinize sağlık.
 
Üst