+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Verileri Aktar Ve Dosya Oluştur (/konu-verileri-aktar-ve-dosya-olustur.html)
Verileri Aktar Ve Dosya Oluştur - baho - 13/04/2020
İyi günler ekli dosyada veri sayfasında B10 :AR89 hücre aralığındaki istif numarası ,çapı,boyu ve adedi yazılı verileri makro ile istif sayfasına istif numarası,çapı,boyu ve adedi yazılı olanları aktarıp ;masa üstüne Ebat Listesi Klasörü ve bu klasörün içerine istif numarasının yazılı olduğu isimle istif sayfasını kaydedebilir miyiz. İnşaallah böyle bir makro yapılabilir. Yardımınızı bekliyorum. Saygılar
Not : C5 hücresindeki istif numarasının istif sayfasındaki gibi bütün aktarılan satırların karşısına yazacak
Not: İstif sayfasında el ile girilmiş verileri makro ile atacak
Dosya yüklemeyi unutmuşum .Dosya ektedir
RE: Verileri Aktar Ve Dosya Oluştur - feraz - 14/03/2021
Alttaki kod kullanılabilir.
Sub aktar()
Dim i As Integer, j As Byte, say As Integer
Dim syfveri As Worksheet
Set syfveri = Sayfa7
Dim syfistif As Worksheet
Set syfistif = Sayfa1
say = 2
syfistif.Range("A2
" & Rows.Count).ClearContents
With syfveri
For i = 10 To 89
For j = 2 To 44 '44 ar sütun no
If LCase(.Cells(9, j).Value) = "adet" And _
Len(.Cells(i, j).Value) > 0 And .Cells(i, j).Interior.ColorIndex = 6 Then '6 demek sari renk
syfistif.Cells(say, 1).Value = .Cells(5, "C").Value
syfistif.Cells(say, 2).Value = .Cells(i, "A").Value
syfistif.Cells(say, 3).Value = .Cells(8, j).Value
syfistif.Cells(say, 4).Value = .Cells(i, j).Value
say = say + 1
End If
Next
Next
End With
MsgBox "islem tamam", vbInformation, "Aktrama"
Set syfveri = Nothing
Set syfistif = Nothing
End Sub