Soru Seçili alanı diğer sayfadaki ilk boş satıra kopyalama

[aygungozek]

Merhaba arkadaşlar,

Excel dosyamda "Genel Maddeler" sayfasında yer alan seçili alanın kopyalanıp "Firma" sayfasındaki ilk boş satıra kopyalanması ile ilgili aşağıdaki kodu yazdım. Bunun gibi yaklaşık 100 makro yazacağım. Ancak bir sıkıntı oluyor.
1. makroyu çalıştırdığımda istediğimi yapıp diğer sayfadaki ilk boş satırdan başlayarak kopyalama yapıyor burada bir sıkıntı yok, problem 2. veya 3. makroyu çalıştırdığımda ilk boş satırdan değilde bir önceki kopyalanan hücrelerin üzerine kopyalama yapıyor.

Benim istediğim ise seçilen makroları çalıştırdıkça diğer sayfaya kopyalama yapacak ve her makro çalıştıktan sonra bir önceki kopyalamanın altındaki ilk boş satırdan başlaması,

Nerede yanlışlık yapıyorum. Değerli yorumlarınızı rica ederim.

Sheets("GENEL MADDELER").Select
    Range("A18:AB21").Select
    Selection.Copy
    sat = Sheets("FİRMA").Cells(Rows.Count, "A").End(xlUp).Row + 1
    Sheets("FİRMA").Select
    Range("A" & sat).PasteSpecial
            Sheets("GENEL KONU BAŞLIKLARI").Select
    Range("B6").Select
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
        MsgBox "Kopyalama Yapıldı..!!"
End Sub

 

[MusaPEKEL]

Denermisiniz.

Sub KopyalamaYap()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim copyRange As Range
    Dim targetRow As Long
    
    ' Genel Maddeler sayfasını ve kopyalanacak alanı belirle
    Set sourceSheet = Sheets("GENEL MADDELER")
    Set copyRange = sourceSheet.Range("A18:AB21")
    
    ' Firma sayfasını belirle
    Set targetSheet = Sheets("FİRMA")
    
    ' Hedef satırı bul
    targetRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1
    
    ' Kopyalama yap
    copyRange.Copy Destination:=targetSheet.Range("A" & targetRow)
    
    ' Diğer işlemleri buraya ekleyebilirsiniz.
    
    ' Örneğin renklendirme işlemi
    targetSheet.Range("B" & targetRow).Interior.Color = 5296274
    
    MsgBox "Kopyalama Yapıldı..!!"
End Sub

 

[aygungozek]

Denermisiniz.

Sub KopyalamaYap()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim copyRange As Range
    Dim targetRow As Long
    
    ' Genel Maddeler sayfasını ve kopyalanacak alanı belirle
    Set sourceSheet = Sheets("GENEL MADDELER")
    Set copyRange = sourceSheet.Range("A18:AB21")
    
    ' Firma sayfasını belirle
    Set targetSheet = Sheets("FİRMA")
    
    ' Hedef satırı bul
    targetRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1
    
    ' Kopyalama yap
    copyRange.Copy Destination:=targetSheet.Range("A" & targetRow)
    
    ' Diğer işlemleri buraya ekleyebilirsiniz.
    
    ' Örneğin renklendirme işlemi
    targetSheet.Range("B" & targetRow).Interior.Color = 5296274
    
    MsgBox "Kopyalama Yapıldı..!!"
End Sub

Çok teşekkür ederim.

 

[Necdet]

Merhaba,
Alternatif olsun.
Madem ki bir sayfada seçilen bilgileri diğer bir sayfaya kopyalamak istiyorsunuz, o halde bunu daha kullanıcı dostu kodlarla yapmak gerek.
Anladığım kadarıyla A:AB sütunları arasında kopyalama yapıyorsunuz. Düzgün kopyalamak için de örneğin A5:AB10 gibi bir alanı seçmek zorundasınız.
Aşağıdaki kodlar bu seçimi kolaylaştırıyor.
Örneğin A5:AB10 arasını sadece bir sütunda diyelim ki F5:F10 arası seçmekle ya da 5:10 satırlarını seçerek te yapabilirsiniz.
tüm veriyi aktarmak isterseniz yine herhangi bir sütunu tümden seçebilirsiniz.

Kodlarda kullandığım Sayfa1 ve Sayfa2 Sayfa indisleridir. vba ekranından baktığınızda sizin "GENEL MADDELER" sayfasının indisini kodda değiştirmelisiniz.
diyelim ki sizde "GENEL MADDELER" sayfasının indisi Sayfa8 (ya da başka bir şey) görünüyorsa Kodda Sayfa1'i Sayfa8 OLARAK DEĞİŞTİRİNİZ.
Ve diğer sayfa indisini de.
Saayfa indisini kullanmamın 2 nedeni var. 1. si yazımı kolay, set etmiyorsunuz, 2. si ise kullanıcı sayfa adını değiştirdiğinde (excelde görünür sayfa adını) kod yine çalışmaya devam eder. Aksi halde hata alırsınız.

Sub SecilenAktar()

Dim arr As Variant
Dim i   As Long
Dim fRow As Long
Dim lRow As Long
Dim lCol As Integer

If Not ActiveSheet.Name = "GENEL MADDELER" Then
    MsgBox "SEÇİMİNİZİ '''GENEL MADDELER''' SAYFASINDA YAPTIKTAN SONRA KODU ÇALIŞTIRINIZ !!!"
    Exit Sub
End If

fRow = Selection(1, 1).Row
lRow = fRow + Selection.Rows.Count - 1
If lRow > Sayfa1.UsedRange.Rows.Count Then lRow = Sayfa1.UsedRange.Rows.Count

lCol = Sayfa1.UsedRange.Columns.Count
arr = Range(Cells(fRow, 1), Cells(lRow, lCol)).Value
i = Sayfa2.Cells(Rows.Count, "a").End(3).Row + 1
Sayfa2.Range("A" & i).Resize(UBound(arr, 1), UBound(arr, 2)) = arr

MsgBox lRow - fRow + 1 & " ADET SATIR KOPYALANMIŞTIR...."

End Sub