Seçileni taşıma

[1903emre34@gmail.com]

Merhaba,

1 numaralı yevmiye madde numaralı kayıt komple seçtiğim zaman (sarı boyalı hücre) sayfa1 aktarmak istiyorum, kod hata verdi.

Sub secileni_tasi()
    Dim cel As Range
    Dim selectedRange As Range
    Set shaktar = Sheets("Yevmiye Defteri")
    Set sharama = Sheets("Sayfa 1")
    
    shaktarson = shaktar.Cells(Rows.Count, "A").End(3).Row + 1
    
    'Rows("1:1").Clear
    If Selection.Count = 1 Then Exit Sub
    sonsatir = sharama.Cells(Rows.Count, "A").End(3).Row
    Set selectedRange = Application.Selection
    
    For Each cel In selectedRange.Cells
      shaktarson = shaktar.Cells(Rows.Count, "A").End(3).Row + 1
      satir = cel.Row
      sharama.Range("A" & satir & ":M" & satir).SpecialCells(xlCellTypeVisible).Copy shaktar.Range("A" & shaktarson)
      sharama.Rows(satir).Clear
    Next cel
    
    'Başlık kopyala
    sharama.Range("A2:M2").SpecialCells(xlCellTypeVisible).Copy shaktar.Range("A1")
    shaktar.Cells.EntireColumn.AutoFit
     
End Sub

http://s3.dosya.tc/server12/s35e1l/secileni_tasi.zip.html

 

[Asri]

Öncelikle bu kod bu dosya için yazılmadı. Yada bu dosyada baya bir değişiklik yapılmış

Kodda sayfaların yerleri değiştirildi.
Set shaktar = Sheets("Sayfa 1")
Set sharama = Sheets("Yevmiye Defteri")

"Yevmiye Defteri" sayfa adında sonda bir boşluk var kaldırıldı.
Sayfa1 de 1 bitişik di Sayfa 1 şeklinde sayfa adı düzeltildi.

Kontrol ediniz.

Sub secileni_tasi()
    Dim cel As Range
    Dim selectedRange As Range
    Set shaktar = Sheets("Sayfa 1")
    Set sharama = Sheets("Yevmiye Defteri")
    
    shaktarson = shaktar.Cells(Rows.Count, "A").End(3).Row + 1
    
    'Rows("1:1").Clear
    If Selection.Count = 1 Then Exit Sub
    sonsatir = sharama.Cells(Rows.Count, "A").End(3).Row
    Set selectedRange = Application.Selection
    
    For Each cel In selectedRange.Cells
      shaktarson = shaktar.Cells(Rows.Count, "A").End(3).Row + 1
      satir = cel.Row
      sharama.Range("A" & satir & ":M" & satir).SpecialCells(xlCellTypeVisible).Copy shaktar.Range("A" & shaktarson)
      sharama.Rows(satir).Clear
    Next cel
    
    'Başlık kopyala
    sharama.Range("A2:M2").SpecialCells(xlCellTypeVisible).Copy shaktar.Range("A1")
    shaktar.Cells.EntireColumn.AutoFit
End Sub

 

[Ömer BARAN]

Merhaba.

-- Seçenek 1: İlgili alan seçildiğinde otomatik aktarma için ilk kod'u kullanabilirsiniz.
(Kod Yevmiye Defteri sayfasının kod bölümüne uygulanmalıdır)

-- Seçenek 2: Aktarma için bir düğme kullanacaksanız bu düğme ile ikinci kod'u ilişkilendrebilirsiniz.
(Kod bir modüle veya Yevmiye Defteri sayfasının kod bölümüne uygulanabilir)
.

[B][COLOR="red"]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/COLOR][/B]
If Selection.Address(0, 0) = "A2:M" & WorksheetFunction.CountIf(Range("B:B"), 1) + 1 Then
    Selection.Copy Sheets("Sayfa1").[A2]
    Sheets("Sayfa1").Columns("A:M").AutoFit
End If
[B][COLOR="Red"]End Sub[/COLOR][/B]


[B][COLOR="Blue"]Sub AÇILIŞI_AKTAR()[/COLOR][/B]
Set yd = Sheets("Yevmiye Defteri "): Set s = Sheets("Sayfa1")
yd.Range("A2:M" & WorksheetFunction.CountIf(yd.Range("B:B"), 1) + 1).Copy s.[A2]
s.Columns("A:M").AutoFit
[B][COLOR="blue"]End Sub[/COLOR][/B]

 

[1903emre34@gmail.com]

Öncelikle bu kod bu dosya için yazılmadı. Yada bu dosyada baya bir değişiklik yapılmış

Kodda sayfaların yerleri değiştirildi.
Set shaktar = Sheets("Sayfa 1")
Set sharama = Sheets("Yevmiye Defteri")

"Yevmiye Defteri" sayfa adında sonda bir boşluk var kaldırıldı.
Sayfa1 de 1 bitişik di Sayfa 1 şeklinde sayfa adı düzeltildi.

Kontrol ediniz.

Sub secileni_tasi()
    Dim cel As Range
    Dim selectedRange As Range
    Set shaktar = Sheets("Sayfa 1")
    Set sharama = Sheets("Yevmiye Defteri")
    
    shaktarson = shaktar.Cells(Rows.Count, "A").End(3).Row + 1
    
    'Rows("1:1").Clear
    If Selection.Count = 1 Then Exit Sub
    sonsatir = sharama.Cells(Rows.Count, "A").End(3).Row
    Set selectedRange = Application.Selection
    
    For Each cel In selectedRange.Cells
      shaktarson = shaktar.Cells(Rows.Count, "A").End(3).Row + 1
      satir = cel.Row
      sharama.Range("A" & satir & ":M" & satir).SpecialCells(xlCellTypeVisible).Copy shaktar.Range("A" & shaktarson)
      sharama.Rows(satir).Clear
    Next cel
    
    'Başlık kopyala
    sharama.Range("A2:M2").SpecialCells(xlCellTypeVisible).Copy shaktar.Range("A1")
    shaktar.Cells.EntireColumn.AutoFit
End Sub

Evet, bu kodlar bu dosya için yazılmadı, aynı yapıda başka bir örnek vardı, kodları ekte dosya uyguladım, olmadı, 2 nolu mesajdaki kodları denedim, olmadı yada ben uygulamayadım.

 

[1903emre34@gmail.com]

Merhaba.

-- Seçenek 1: İlgili alan seçildiğinde otomatik aktarma için ilk kod'u kullanabilirsiniz.
(Kod Yevmiye Defteri sayfasının kod bölümüne uygulanmalıdır)

-- Seçenek 2: Aktarma için bir düğme kullanacaksanız bu düğme ile ikinci kod'u ilişkilendrebilirsiniz.
(Kod bir modüle veya Yevmiye Defteri sayfasının kod bölümüne uygulanabilir)
.

[B][COLOR="red"]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/COLOR][/B]
If Selection.Address(0, 0) = "A2:M" & WorksheetFunction.CountIf(Range("B:B"), 1) + 1 Then
    Selection.Copy Sheets("Sayfa1").[A2]
    Sheets("Sayfa1").Columns("A:M").AutoFit
End If
[B][COLOR="Red"]End Sub[/COLOR][/B]


[B][COLOR="Blue"]Sub AÇILIŞI_AKTAR()[/COLOR][/B]
Set yd = Sheets("Yevmiye Defteri "): Set s = Sheets("Sayfa1")
yd.Range("A2:M" & WorksheetFunction.CountIf(yd.Range("B:B"), 1) + 1).Copy s.[A2]
s.Columns("A:M").AutoFit
[B][COLOR="blue"]End Sub[/COLOR][/B]

Sn.Baran, teşekkürler ama Mouse ile seçip (herhangi yevmiye kayıt numarası) seçenek 2'deki düğmeye ait olan kodları çalıştırdığım zaman Sayfa1 aktarılmasını istiyorum.

 

[Asri]

Evet, bu kodlar bu dosya için yazılmadı, aynı yapıda başka bir örnek vardı, kodları ekte dosya uyguladım, olmadı, 2 nolu mesajdaki kodları denedim, olmadı yada ben uygulamayadım.

Dosya ektedir.

Deneyiniz.

 

[Ömer BARAN]

Merhaba,

1 numaralı yevmiye madde numaralı kayıt komple seçtiğim zaman (sarı boyalı hücre) sayfa1 aktarmak istiyorum, kod hata verdi.

Sn.Baran, teşekkürler ama Mouse ile seçip (herhangi yevmiye kayıt numarası) seçenek 2'deki düğmeye ait olan kodları çalıştırdığım zaman Sayfa1 aktarılmasını istiyorum.

İhtiyacı tam ve net şekilde ifade etmeyince iki kişi cevaplar yazıp, isteğinizin ne olduğunu anlamaya çalışıyor.

Bence sorunuzu net sormalısınız.
-- Bir yevmiye maddesi satırlarını (tüm alan) seçtiğinizde mi?
-- Yevmiye no sütunundaki herhangi bir hücre aktif iken, bu hücrede yer alan numarayı taşıyan yevmiye maddesi düğme kullanarak mı aktarılacak?

Sayın asri çözüm üretmiştir diye düşünüyorum.
İyi çalışmalar dilerim.
.