işlemi ve işlevi biten bilgilerin gizlenmesi

[mitko]

sitenize yeni üye oldum ve ilgi ile takip etmekteyim, aşağıda kodlarını paylaştığım makro için bir ekleme yapmak istiyorum yardım ederseniz sevinirim..

havuz fonlar ve emeklilik diye belirtilmiş olan hesap numaralarının kümüle toplamları alınıp text e yazılıyor ama benim istediğim bu toplamlar alınıp yine yazılsın ama belirtilen hesaplar liste olarak yazılmasın

yardımlarınızı rica ederim,

Sub macro()

  Dim sUserName As String
  sUserName = Environ("username")

  Columns("A:E").Select
    
    Range("A1").Select
    Selection.End(xlDown).Select
    Dim Row As Integer
    Dim eq As Integer
    
    
    Row = ActiveCell.Row
    
    
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1:A" & (Row) & "") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:E" & (Row) & "")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ActiveWindow.SmallScroll Down:=-27
    Columns("C:C").Select
    Columns("D:D").Select
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E1").Select
    ActiveCell.Value = "@"
    Range("E1").Select
    Selection.AutoFill Destination:=Range("E1:E" & (Row) & "")
    Range("E1:E106").Select
    
    For i = 1 To Row 'change A to B buy/sell
        If InStr(Cells(i, 3), "A") > 0 Then
            Cells(i, 3) = "B"
        End If
    Next
   '  Columns("D:D").Select
   ' Selection.NumberFormat = "#,##0"
    
    '  Columns("D:D").Select
    'Selection.NumberFormat = "General"
    
    
    Open "C:\Users\" & (sUserName) & "\Desktop\GünSonu.txt" For Output As #1 'write data to file
    Dim accountCheck As Boolean
    Dim accountCount As Integer
    Dim havuz As Variant
    Dim fonlar As Variant
    Dim emeklilik As Variant
    Dim havuzSum As Variant
    Dim fonlarSum As Variant
    Dim emeklilikSum As Variant
    
    
    havuz = Array("123456")
    fonlar = Array("987654", "654321", "456789")
    emeklilik = Array("741741", "852852", "963963")
    
    
    
     For i = 1 To Row
        accountCheck = False
        
       ' While (InStr(Cells(i, 1), Cells(i + 1, 1)) > 0) 'while account numbers are equal
   
Iterate:
      
          If Cells(i, 4) <> 0 Then 'check it's 0 or not
            If accountCheck = False Then
                Print #1, "Acc" & (i) & "", Cells(i, 1) 'write account number as header
                Print #1, "=============="
                accountCheck = True
            End If
               
                     For j = 2 To 6
                           If j = 6 Then
                                 Print #1, Replace(Cells(i, j), ",", ".") 'replace ',' with '.'
                            Else
                                Print #1, Cells(i, j),
                            End If
                     Next
           'calculate sums
            For k = 0 To UBound(havuz) 'havuz sum
                If InStr(havuz(k), Cells(i, 1)) > 0 Then 'search current rows account no in all accounts
                    havuzSum = havuzSum + (Cells(i, 4) * Cells(i, 6))
                End If
            Next
            
            For k = 0 To UBound(fonlar) 'fonlar sum
                If InStr(fonlar(k), Cells(i, 1)) > 0 Then 'search current rows account no in all accounts
                    fonlarSum = fonlarSum + (Cells(i, 4) * Cells(i, 6))
                End If
            Next
            
            For k = 0 To UBound(emeklilik) 'emeklilik sum
                If InStr(emeklilik(k), Cells(i, 1)) > 0 Then 'search current rows account no in all accounts
                    emeklilikSum = emeklilikSum + (Cells(i, 4) * Cells(i, 6))
                End If
            Next
            
                                 
           
         End If
         If (InStr(Cells(i, 1), Cells(i + 1, 1)) > 0) Then
                i = i + 1
                GoTo Iterate
         End If
        'Wend
      
        Print #1, "" & Chr(13) & "" 'put some space between accounts
        Print #1, "" & Chr(13) & ""
        ' Print #1, "  "
        ' Print #1, "  "
     
     Next
        
         Print #1, "havuz: " & (havuzSum)
         Print #1, "fonlar: " & (fonlarSum)
         Print #1, "emeklilik: " & (emeklilikSum)
    Close #1
End Sub