Soru Son Dolu Satıra Kadar Aktar

[Hsn55]

İyi günler;
Ekli örnek dosyada Veri Girişi sayfasında C24:K hücreleri arasında dolu olan satırları yuvarlak ağaç ölçü tutanağı sayfasında H24 hücreleri arasına makro ile aktarabilir miyiz. Ayrıca her aktarılan satıra F24 hücresinden başlamak üzere sayı numarası ve Veri Girişi G19 hücresindeki tarihi ise H24 hücresinden başlamak üzere tarihi yazdırabilir miyiz. Yardımcı olursanız sevinirim. Şimdiden teşekkür ederim
Dosya: https://dosya.co/cixlavgg9kn3/Aktar.xlsm.html

 

[tukayf]

Merhabalar. Kurumun güvenlik duvarı dosyayı indirmeyi engelliyor. H24ten itibaren tarih mi gelecek yoksa veri sayfasının değerleri mi ? Aktarma alt alta devam mı edecek. Her seferinde bir öncekiler silinecek mi daha detaylı yazabilir misiniz

 

[Hsn55]

Hayır. F sütunu sıra no G sütüna ise tarih gelecek

 

[tukayf]

Aktarma alt alta devam mı edecek. Her seferinde bir öncekiler silinecek mi daha detaylı yazabilir misiniz

 

[catalinastrap]

Kodu denermisiniz

Sub VeriAktar()
Dim wsVeri As Worksheet, wsTutanak As Worksheet
Dim veriSatir As Long, sonSatir As Long, tutanakSatir As Long
Dim sayac As Long, sonTutanakSatir As Long
Dim aktarilacakTarih As Variant

Set wsVeri = ThisWorkbook.Sheets("Veri Girişi")
Set wsTutanak = ThisWorkbook.Sheets("Yuvarlak Ağaç Ölçü Tutanağı")

aktarilacakTarih = wsVeri.Range("G19").Value


sonTutanakSatir = wsTutanak.Cells(wsTutanak.Rows.Count, "F").End(xlUp).Row
If sonTutanakSatir < 24 Then
tutanakSatir = 24
sayac = 1
Else
tutanakSatir = sonTutanakSatir + 1
sayac = wsTutanak.Cells(sonTutanakSatir, "F").Value + 1
End If


sonSatir = wsVeri.Cells(wsVeri.Rows.Count, "C").End(xlUp).Row

For veriSatir = 24 To sonSatir

If Application.CountA(wsVeri.Range(wsVeri.Cells(veriSatir, "C"), wsVeri.Cells(veriSatir, "K"))) > 0 Then

wsTutanak.Cells(tutanakSatir, "F").Value = sayac

wsTutanak.Cells(tutanakSatir, "G").Value = aktarilacakTarih

wsTutanak.Range(wsTutanak.Cells(tutanakSatir, "H"), wsTutanak.Cells(tutanakSatir, "O")).Value = _
wsVeri.Range(wsVeri.Cells(veriSatir, "C"), wsVeri.Cells(veriSatir, "J")).Value

wsTutanak.Cells(tutanakSatir, "P").Value = wsVeri.Cells(veriSatir, "K").Value
tutanakSatir = tutanakSatir + 1
sayac = sayac + 1
End If
Next veriSatir

MsgBox "Aktarma işlemi tamamlandı!"
End Sub

 

[Hsn55]

Sayın hocam çok teşekkür ederim.. Dosya sonuna bir sütun ekledim . Aktarma yaptıktan sonra en son satıra veri girişi sayfasındaki D19 hücresindeki yazıyı ve aktarılan verilen g,j,k ve l sutünlardaki verileri toplatıp, renklerini dosyadaki gibi makro ile yaptırabilir miyiz. ?.Biraz zor gibi görünüyor

İndir Aktar (5) xlsm

Dosyayı indir Aktar (5) xlsm

dosya.co