Anasayfa » Forum

Makro ile sayfanın ...
 

Makro ile sayfanın sonuna kayıt problemi  

  RSS
HAKAN YURTDAGÜL
(@yabanim)
Üye
Merhaba;

Aşağıdaki koda ilgili  kodun son kısmını çözemedim. Dosyasını açtıktan sonra boş olan son satıra veriyi getirmesini nasıl sağlarım.

kod mevcut  verinin üstüne gelip değişiklik yapıyor.Oysa ben eski verinin de kalmasını istiyorum. Desteğiniz için şimdiden teşekkür ederim

Sub DosyaAra()
Sayfa1.Range("AG1:AG5000").ClearContents
For i = 3 To Sayfa1.Range("A50000").End(xlUp).Row
'sayfa1.Cells(i,"A")
'Sayfa1.Range("A50000").End(xlUp).Row
dizin = Dir(ThisWorkbook.Path & "\")
varmi = "h"
Do While dizin <> ""
DoEvents
dosyaisim = Left(dizin, WorksheetFunction.Find(".", dizin) - 1)

If Sayfa1.Cells(i, "A") = dosyaisim Then
Set excel = Workbooks.Open(ThisWorkbook.Path & "\" & dizin)
sat = 2
varmi = "e"
For a = 3 To Sayfa1.Range("A50000").End(xlUp).Row
If Sayfa1.Cells(a, "A") = dosyaisim And Sayfa1.Cells(a, "AG") <> "*" Then

excel.Sheets("CB").Range("A" & sat) = Sayfa1.Cells(a, "F")
excel.Sheets("CB").Range("B" & sat) = Sayfa1.Cells(a, "J")
excel.Sheets("CB").Range("c" & sat) = Sayfa1.Cells(a, "R")
excel.Sheets("CB").Range("D" & sat) = Sayfa1.Cells(a, "A")
excel.Sheets("CB").Range("E" & sat) = Sayfa1.Cells(a, "S")
excel.Sheets("CB").Range("F" & sat) = Sayfa1.Cells(a, "Q")
excel.Sheets("CB").Range("G" & sat) = Sayfa1.Cells(a, "U")

excel.Sheets("CB").Range("H" & sat) = Sayfa1.Cells(a, "V")
excel.Sheets("CB").Range("I" & sat) = Sayfa1.Cells(a, "W")
excel.Sheets("CB").Range("J" & sat) = Sayfa1.Cells(a, "X")
excel.Sheets("CB").Range("K" & sat) = Sayfa1.Cells(a, "Y")
excel.Sheets("CB").Range("L" & sat) = Sayfa1.Cells(a, "Z")

Sayfa1.Cells(a, "AG") = "*"

sat = sat + 1
End If
Next a
excel.Save
excel.Close
Set excel = Nothing

End If

dizin = Dir()
Loop

sat = 2
If varmi = "h" Then

Set yeni = Workbooks.Add
'yeni.Sheets.Add
yeni.Sheets(1).Name = "CB"

yeni.Sheets("CB").Range("A1") = "MalzemeSistemKodu"
yeni.Sheets("CB").Range("b1") = "MalzemeAciklamasi"
yeni.Sheets("CB").Range("c1") = "Sınıf"
yeni.Sheets("CB").Range("d1") = "Musteri"
yeni.Sheets("CB").Range("e1") = "FiyatTuru"
yeni.Sheets("CB").Range("f1") = "TeklifTarihi"
yeni.Sheets("CB").Range("g1") = "TeklifFiyati"
yeni.Sheets("CB").Range("h1") = "FiyatBirimi"
yeni.Sheets("CB").Range("I1") = "İskonto Oranı"
yeni.Sheets("CB").Range("j1") = "BİRİM FİYAT"
yeni.Sheets("CB").Range("K1") = "Fiyat birimi"
yeni.Sheets("CB").Range("L1") = "Aciklama"

For a = 2 To Sayfa1.Range("A50000").End(xlUp).Row
If Sayfa1.Cells(i, "A") = Sayfa1.Cells(a, "A") And Sayfa1.Cells(a, "AG") <> "*" Then

yeni.Sheets("CB").Range("A" & sat) = Sayfa1.Cells(a, "F")
yeni.Sheets("CB").Range("B" & sat) = Sayfa1.Cells(a, "J")
yeni.Sheets("CB").Range("c" & sat) = Sayfa1.Cells(a, "R")
yeni.Sheets("CB").Range("D" & sat) = Sayfa1.Cells(a, "A")
yeni.Sheets("CB").Range("E" & sat) = Sayfa1.Cells(a, "S")
yeni.Sheets("CB").Range("F" & sat) = Sayfa1.Cells(a, "Q")
yeni.Sheets("CB").Range("G" & sat) = Sayfa1.Cells(a, "U")

yeni.Sheets("CB").Range("H" & sat) = Sayfa1.Cells(a, "V")
yeni.Sheets("CB").Range("I" & sat) = Sayfa1.Cells(a, "W")
yeni.Sheets("CB").Range("J" & sat) = Sayfa1.Cells(a, "X")
yeni.Sheets("CB").Range("K" & sat) = Sayfa1.Cells(a, "Y")
yeni.Sheets("CB").Range("L" & sat) = Sayfa1.Cells(a, "Z")

Sayfa1.Cells(a, "AG") = "*"
sat = sat + 1
End If
Next a
yeni.SaveAs ThisWorkbook.Path & "\" & Sayfa1.Cells(i, "A")
yeni.Close
Set yeni = Nothing
End If

Next i
End Sub
Sub test()
If varmi = "" Then
MsgBox Sayfa1.Cells(i, "A") & " " & dosyaisim
Set yeni = Workbooks.Add
'yeni.Sheets.Add
yeni.Sheets(1).Name = "CB"

For a = 3 To Sayfa1.Range("A50000").End(xlUp).Row
'For i = 2 To .Range("A" & Rows.Count).End(3).Row 'BENİM EKLEDİĞİM KOŞUL
If Sayfa1.Cells(a, "A") = dosyaisim And Sayfa1.Cells(a, "AG") <> "*" Then

yeni.Sheets("CB").Range("A" & sat) = Sayfa1.Cells(a, "F")
yeni.Sheets("CB").Range("B" & sat) = Sayfa1.Cells(a, "J")
yeni.Sheets("CB").Range("c" & sat) = Sayfa1.Cells(a, "R")
yeni.Sheets("CB").Range("D" & sat) = Sayfa1.Cells(a, "A")
yeni.Sheets("CB").Range("E" & sat) = Sayfa1.Cells(a, "S")
yeni.Sheets("CB").Range("F" & sat) = Sayfa1.Cells(a, "Q")
yeni.Sheets("CB").Range("G" & sat) = Sayfa1.Cells(a, "U")

yeni.Sheets("CB").Range("H" & sat) = Sayfa1.Cells(a, "V")
yeni.Sheets("CB").Range("I" & sat) = Sayfa1.Cells(a, "W")
yeni.Sheets("CB").Range("J" & sat) = Sayfa1.Cells(a, "X")
yeni.Sheets("CB").Range("K" & sat) = Sayfa1.Cells(a, "Y")
yeni.Sheets("CB").Range("L" & sat) = Sayfa1.Cells(a, "Z")

Sayfa1.Cells(a, "AG") = "*"
sat = sat + 1
End If
Next a
yeni.SaveAs ThisWorkbook.Path & "\" & dosyaisim
yeni.Close
Set yeni = Nothing
End If
End Sub

 
Bu konu 2 hafta önce Hakan Uzuner tarafından düzenlendi
Alıntı
Gönderildi : 04/10/2019 13:58
Hakan Uzuner
(@hakanuzuner)
Kıdemli Üye Yönetici

Son alandaki bilgiler garip geldiği için sildim, yani yukarıdaki sorgu ile aşağıdaki örneğin ileti alakasızdı?

Danışman - ITSTACK Bilgi Sistemleri
****************************************************************
Probleminiz Çözüldüğünde Sonucu Burada Paylaşırsanız.
Sizde Aynı Problemi Yaşayanlar İçin Yardım Etmiş Olursunuz.
Eğer sorununuz çözüldü ise lütfen "çözüldü" olarak işaretlerseniz diğer üyeler için çok büyük kolaylık sağlayacaktır.
*****************************************************************

CevapAlıntı
Gönderildi : 05/10/2019 10:02
HAKAN YURTDAGÜL
(@yabanim)
Üye

Hakan  bey merhaba;

 

son mesajınızı  anlamadım eke örrnek eklemeye çalışmıştım yanlışmı eklemişim.

 

Kolay gelsin iyi çalışmalar

CevapAlıntı
Gönderildi : 07/10/2019 12:24
Hakan Uzuner
(@hakanuzuner)
Kıdemli Üye Yönetici

Bende sorunu anlamadım 🙁 yani hangi alandan bahsediyorsun?

Danışman - ITSTACK Bilgi Sistemleri
****************************************************************
Probleminiz Çözüldüğünde Sonucu Burada Paylaşırsanız.
Sizde Aynı Problemi Yaşayanlar İçin Yardım Etmiş Olursunuz.
Eğer sorununuz çözüldü ise lütfen "çözüldü" olarak işaretlerseniz diğer üyeler için çok büyük kolaylık sağlayacaktır.
*****************************************************************

CevapAlıntı
Gönderildi : 07/10/2019 14:11
HAKAN YURTDAGÜL
(@yabanim)
Üye

Hakan Bey merhaba;

Ekteki dosyadan  yukarıdaki makro aracılığı ile aynı klasör içersinde  cari adlarına göre arayıp varsa o cariyi açıp yoksa yeni cari açarak o teklifleri dolu olan en son satırdan başlayarak kopyalayıp kaydetmesini istiyorum . Hli hazırda olan makro cariyi arıyor yoksa yeni cari açıyor ve mevcut kodun üzerinde değişiklik yapıyor oysa ben yeni bilgiyi boş olan alt satıra ekleyip kaydetmesini istiyorum.

Makro konusunda çok fazla bir bilgim yok yardımcı olursanız sevinirim.

Desteğiniz için şimdiden çok teşekkür ederim

Bu ileti 1 hafta önce HAKAN YURTDAGÜL tarafından düzenlendi
CevapAlıntı
Gönderildi : 08/10/2019 08:24
Hakan Uzuner
(@hakanuzuner)
Kıdemli Üye Yönetici

Anladım ama bir fikrim yok, bilen birileri belki yardımcı olur.

Danışman - ITSTACK Bilgi Sistemleri
****************************************************************
Probleminiz Çözüldüğünde Sonucu Burada Paylaşırsanız.
Sizde Aynı Problemi Yaşayanlar İçin Yardım Etmiş Olursunuz.
Eğer sorununuz çözüldü ise lütfen "çözüldü" olarak işaretlerseniz diğer üyeler için çok büyük kolaylık sağlayacaktır.
*****************************************************************

CevapAlıntı
Gönderildi : 09/10/2019 12:08
HAKAN YURTDAGÜL
(@yabanim)
Üye

Merhaba;

konu ile ilgili desteğinizi rica ederim

CevapAlıntı
Gönderildi : 10/10/2019 17:13
Paylaş:

Lütfen Giriş yap yada Kayıt ol