besen
Altın Üye
- Katılım
- 23 Mart 2007
- Mesajlar
- 822
- Excel Vers. ve Dili
- Microsoft Office LTSC Professional Plus 2021
İngilizce
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Çok teşekkürler. Para kolonları formatı şu şekilde geliyor.
Borç Alacak Bakiye
1000 1000
İşlemler sayfasındaki gibi olabilir mi?
Borç Alacak Bakiye
1.000,00 1.000,00
Haklısınız .Bir kolonun yerini değiştirmiştim ondan olmuş.
Veri ve İşlemler sayfaları haricinde yeni bir sayfa yarattığımda, aktar işleminden sonra bu sayfayı siliyor.
Tekrar teşekkür ederim.
Selamlar...
Günaydın. "Veri ve İşlemler sayfaları haricinde yeni bir sayfa eklediğimde, aktar işleminden sonra bu sayfayı siliyor."
bunu kontrol edebilir misiniz.
Teşekkür ederim.
Kullanıcının açtığı sayfalar kalsın.
Teşekkür ederim.
Sub Aktar()
Set sV = Sheets("Veri")
Set sI = Sheets("İşlemler")
Set baslikV = sV.Range("A1:G1")
Set baslikI = sI.Range("A1:G1")
baslikVeri = Join(Application.Index(baslikV.Value, 0))
Application.DisplayAlerts = False
For i = Worksheets.Count To 1 Step -1
With Sheets(i)
If Not (.Name = "Veri" Or .Name = "İşlemler") Then
If baslikVeri = Join(Application.Index(.Range("A1:G1").Value, 0)) Then .Delete
End If
End With
Next i
For i = 2 To sV.Cells(Rows.Count, 2).End(3).Row
Sheets.Add , Sheets(2)
ActiveSheet.Name = sV.Cells(i, 2).Value
baslikV.Copy Range("A1")
sV.Range("A" & i & ":G" & i).Copy Range("A2")
baslikI.Copy Range("A4")
Range("G4").Copy Range("H4")
Range("H4").Value = "Bakiye"
sat = 4
Bakiye = 0
Set kirmizi = Range("B2")
For ii = 2 To sI.Cells(Rows.Count, 2).End(3).Row
If sI.Cells(ii, 2) = Range("B2") Then
sat = sat + 1
sI.Cells(ii, 1).Resize(, 7).Copy Cells(sat, 1)
Bakiye = Bakiye + Cells(sat, 7) - Cells(sat, 6)
Cells(sat, 8).Value = Bakiye
Cells(sat, 8).NumberFormat = Cells(sat, 7).NumberFormat
Set kirmizi = Union(kirmizi, Cells(sat, 2))
End If
Next ii
Set kirmizi = Union(kirmizi, Cells(sat, 8))
kirmizi.Font.Bold = True
kirmizi.Font.Color = vbRed
Columns.AutoFit
Next i
Application.DisplayAlerts = True
End Sub
Kod:Sub Aktar() Set sV = Sheets("Veri") Set sI = Sheets("İşlemler") Set baslikV = sV.Range("A1:G1") Set baslikI = sI.Range("A1:G1") baslikVeri = Join(Application.Index(baslikV.Value, 0)) Application.DisplayAlerts = False For i = Worksheets.Count To 1 Step -1 With Sheets(i) If Not (.Name = "Veri" Or .Name = "İşlemler") Then If baslikVeri = Join(Application.Index(.Range("A1:G1").Value, 0)) Then .Delete End If End With Next i For i = 2 To sV.Cells(Rows.Count, 2).End(3).Row Sheets.Add , Sheets(2) ActiveSheet.Name = sV.Cells(i, 2).Value baslikV.Copy Range("A1") sV.Range("A" & i & ":G" & i).Copy Range("A2") baslikI.Copy Range("A4") Range("G4").Copy Range("H4") Range("H4").Value = "Bakiye" sat = 4 Bakiye = 0 Set kirmizi = Range("B2") For ii = 2 To sI.Cells(Rows.Count, 2).End(3).Row If sI.Cells(ii, 2) = Range("B2") Then sat = sat + 1 sI.Cells(ii, 1).Resize(, 7).Copy Cells(sat, 1) Bakiye = Bakiye + Cells(sat, 7) - Cells(sat, 6) Cells(sat, 8).Value = Bakiye Cells(sat, 8).NumberFormat = Cells(sat, 7).NumberFormat Set kirmizi = Union(kirmizi, Cells(sat, 2)) End If Next ii Set kirmizi = Union(kirmizi, Cells(sat, 8)) kirmizi.Font.Bold = True kirmizi.Font.Color = vbRed Columns.AutoFit Next i End Sub
yok hocam orada bir sorunum yok benim mesala bir müşteriye ait bilgileri giriyorum mesala beyaz ayçekirdek olsun bu müşterinin o satırında kg veya fiyatını veya başka birşeyini değiştirdiğimde onu farklı görüyor ikinci bir satır açıyor sizin burda yaptığınız çalışmada denedim satır içinde değişiklik yaptım o yine aynı satırda değişikliği yapıyor ikinci bir satır açmıyor. hocam bu formata gör tabloyu uyalarsanız çok sevinirim
hocam çok sağolun tam istediğim gibi satırdaki bilgileri değiştirdiğimde aktarma yaptığımda yeni satır eklemiyor. o satır içinde değişikliği yapıyor.
hocam birşey soracağım 1500-2000 satır arası bilgi giriyorum bu aktarmada çok bilgi olunca bir sıkıntı olurmu. birde uygun hocamın a sütünundaki formul bu aktarımla mı ilgili.
... birde uygun hocamın a sütünundaki formul bu aktarımla mı ilgili.