kaynaktan rapor sayfasına aktarma

[dayi10]

Merhabalar Örnek excel dosyası ektedir.

Yapmak istediğim şey;

kaynak sayfasında D sütununda bulunan harflerin(değişken olabilir isimde olabilir) karşısında N sütununda bulunan değerleri rapor sayfasında hangi harfin sütununa denk geliyorsa o sütunda aşağıda doğru sıralamasını istiyorum Yani kaynak sayfasından D sütunundaki a harflerinin karşısındaki değerleri rapor sayfasında A2 hücresinden itibaren aşağıda doğru sıralamasını bir buton aracılığıyla modülle yapmak istiyorum.

Teşekkür ederim yardımlarınız için.

 

[Ömer BARAN]

Merhaba.
Aşağıdaki kod'u dener misiniz.

Sub AKTAR()
Dim k As Worksheet: Set k = Sheets("kaynak")
Dim r As Worksheet: Set r = Sheets("rapor")
sonk = k.[D65536].End(3).Row

r.Range("A2:L65536").ClearContents

For a = 2 To sonk
    If k.Cells(a, 4) = "" Then
        a = a + 1
    End If
aa = WorksheetFunction.Match(k.Cells(a, 4), r.Range(1 & ":" & 1), 0)
sonr = r.Cells(65536, aa).End(3).Row + 1

r.Cells(sonr, aa) = k.Cells(a, 14)
Next

End Sub

 

[Orion1]

Alternatif;
Dosyanız ektedir.

Sub aktar59()
Dim i As Byte, sh As Worksheet
Sheets("kaynak").Select
Set sh = Sheets("rapor")
sh.Range("A2:L" & Rows.Count).ClearContents
Application.ScreenUpdating = False
Range("A1").AutoFilter
For i = 1 To 12
    Range("A1").AutoFilter field:=4, Criteria1:=sh.Cells(1, i).Value
    Range("A1").CurrentRegion.Offset(1, 13).Copy
    sh.Range(sh.Cells(2, i), sh.Cells(2, i)).PasteSpecial xlPasteValuesAndNumberFormats
Next i
Application.CutCopyMode = False
Range("A1").AutoFilter
Application.ScreenUpdating = True
sh.Select
Range("A1").Select
MsgBox "Veriler aktarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[dayi10]

Alternatif;
Dosyanız ektedir.

Sub aktar59()
Dim i As Byte, sh As Worksheet
Sheets("kaynak").Select
Set sh = Sheets("rapor")
sh.Range("A2:L" & Rows.Count).ClearContents
Application.ScreenUpdating = False
Range("A1").AutoFilter
For i = 1 To 12
    Range("A1").AutoFilter field:=4, Criteria1:=sh.Cells(1, i).Value
    Range("A1").CurrentRegion.Offset(1, 13).Copy
    sh.Range(sh.Cells(2, i), sh.Cells(2, i)).PasteSpecial xlPasteValuesAndNumberFormats
Next i
Application.CutCopyMode = False
Range("A1").AutoFilter
Application.ScreenUpdating = True
sh.Select
Range("A1").Select
MsgBox "Veriler aktarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

Burada kaynakta 4. Satırdan itibaren arattirmak istiyorum nasil yapabilirim yazdığınız kodda bulamadim.

birde N sütunundaki 0 olan değerleri aktarmamasını istiyorum.

yardımlarınız için teşekkür ederim...

 

[dayi10]

Burada kaynakta 4. Satırdan itibaren arattirmak istiyorum nasil yapabilirim yazdığınız kodda bulamadim.

birde N sütunundaki 0 olan değerleri aktarmamasını istiyorum.

 

[Orion1]

Burada kaynakta 4. Satırdan itibaren arattirmak istiyorum nasil yapabilirim yazdığınız kodda bulamadim.

birde N sütunundaki 0 olan değerleri aktarmamasını istiyorum.

yardımlarınız için teşekkür ederim...

Burada otomatik filtre için kod yazdım.Otamatik filtre ile aktarıyorum.

Range("A1").autofilter

Yukarıdaki kod ile a1 den itibaren 1nci satırdan otomatik filtre yaptığı kabul edilmiştir.Çünkü yolladığınız örnek dosyada , verileriniz 2nci satırdan başlamaktadır.
A1 yazan yerlere A3 yazarsanız ,A4 ten itibaren filtre başlar.
Ekli dosyayı inceleyiniz.
Not 0 (sıfır) olanlar aktarılmamaktadır.

Sub aktar59()
Dim i As Byte, sh As Worksheet
Sheets("kaynak").Select
Set sh = Sheets("rapor")
sh.Range("A2:L" & Rows.Count).ClearContents
Application.ScreenUpdating = False
Range("A1").AutoFilter
For i = 1 To 12
    Range("A1").AutoFilter field:=4, Criteria1:=sh.Cells(1, i).Value
    Range("A1").AutoFilter field:=14, Criteria1:=">0"
    Range("A1").CurrentRegion.Offset(1, 13).Copy
    sh.Range(sh.Cells(2, i), sh.Cells(2, i)).PasteSpecial xlPasteValuesAndNumberFormats
Next i
Application.CutCopyMode = False
Range("A1").AutoFilter
Application.ScreenUpdating = True
sh.Select
Range("A1").Select
MsgBox "Veriler aktarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[dayi10]

A1 leri A3e çevirdim olmadı. Acaba nerede hata yapıyorum.