Soru excel vba

Alicimri' Alıntı:

Hata veren kodların bulunduğu dosyayı eklemeyi unutmuşsunuz

Genişletmek için tıkla...

hicosum' Alıntı:

böyle bir excel dosyası var elimde vba kodum şu şekilde
Sub IcmalGuncelle()
Dim ws As Worksheet, icmalWs As Worksheet
Dim lastRow As Long, icmalLastRow As Long
Dim i As Long, sayac As Long
Dim bg As Long
Dim cellValue As String
Dim tanim As String
Dim topIndex As Long
Dim malzemeToplam As Double, iscilikToplam As Double
Dim giderToplam As Double, genelToplam As Double

' İcmal sayfasını al veya oluştur
On Error Resume Next
Set icmalWs = ThisWoarkbook.Worksheets("İcmal")
On Error GoTo 0
If icmalWs Is Nothing Then
Set icmalWs = ThisWorkbook.Worksheets.Add
icmalWs.Name = "İcmal"
End If

' Sadece 11. satırdan itibaren olan verileri temizle
With icmalWs
.Range("C11:H" & .Cells(.Rows.Count, "D").End(xlUp).Row).ClearContents
End With

icmalLastRow = 11
sayac = 1

' Diğer sayfalardan verileri al
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "İcmal" Then
lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
For i = 1 To lastRow
cellValue = ws.Cells(i, "D").Value
bg = ws.Cells(i, "D").Interior.Color
If bg = RGB(191, 191, 191) Then
If Trim(cellValue) <> "" And InStr(1, LCase(cellValue), "genel toplam") = 0 Then
topIndex = InStr(1, cellValue, "TOPLAMI", vbTextCompare)
If topIndex > 0 Then
tanim = Trim(Left(cellValue, topIndex - 1))
If tanim <> "" Then
With icmalWs
.Cells(icmalLastRow, "C").Value = sayac & "."
.Cells(icmalLastRow, "D").Value = tanim
.Cells(icmalLastRow, "E").Value = ws.Cells(i, "I").Value
.Cells(icmalLastRow, "F").Value = ws.Cells(i, "K").Value
.Cells(icmalLastRow, "G").Value = ws.Cells(i, "M").Value
.Cells(icmalLastRow, "H").Value = ws.Cells(i, "O").Value
End With

' Toplamlar
malzemeToplam = malzemeToplam + Val(ws.Cells(i, "I").Value)
iscilikToplam = iscilikToplam + Val(ws.Cells(i, "K").Value)
giderToplam = giderToplam + Val(ws.Cells(i, "M").Value)
genelToplam = genelToplam + Val(ws.Cells(i, "O").Value)

icmalLastRow = icmalLastRow + 1
sayac = sayac + 1
End If
End If
End If
End If
Next i
End If
Next ws

' GENEL TOPLAM satırı
With icmalWs
.Cells(icmalLastRow, "D").Value = "GENEL TOPLAM"
.Cells(icmalLastRow, "E").Value = malzemeToplam
.Cells(icmalLastRow, "F").Value = iscilikToplam
.Cells(icmalLastRow, "G").Value = giderToplam
.Cells(icmalLastRow, "H").Value = genelToplam
End With

MsgBox "İcmal sayfası güncellendi.", vbInformation
End Sub
**************kodda istediğim her şey çalışıyor ama şurda hep hata alıyorum nasıl yapıcagımı bilmiyorum yeni bir satır eklendiğinde genel toplamın verilerini ve arkaplan rengini bozmadan her seferinde bi alta geçmesini sağlayamadım yardımcı olurdsnız COK SEVİNİİRM

Genişletmek için tıkla...