简体   繁体   中英

VBA Excel 2007 : Need to loop copy and loop count number except zero every row above

i'm a complete noob in vba so i'm searching all over the net to combine the code but right now it seems i hit the great wall and can't get it right. what i wanna do are:

  • to sum every row above and add extra row above (somehow i get this right)
  • in extra row (i said above) i want to count every cells above that have value more than zero (in excel i use simple count if formula but i cant do it in vba)
  • to loop the step above in another sheet in this workbook except sheet 1 (the quantity of sheets can vary depend on the input, so i believe this can be done by loop but i dont know how)
  • to copy the output of the step above into sheet 1

this is my code so far and since i cant do loop i did it manualy for sheet2 and sheet3. i get stuck in step 2

here is the code that've been modified taken from @NEOman' code

    Sub Copy_Sum()

Dim ws As Worksheet
'Selecting the worksheets to loop through
K = 1
For Each ws In ThisWorkbook.Worksheets
'Skiping the sheet1
    If ws.Name <> "Sheet1" Then
'Counting the number of rows for automation
         rowscount = Cells(Rows.Count, 1).End(xlUp).Row
         temp = 0
'Looping throught the cells for the calculation
             For j = 2 To (rowscount)
           'Counting the number of cells which value greater than zero
                  If Cells(j, 9) > 0 Then
                  temp = temp + 1
                  End If
              Next j

'Counting the number of rows for automation
         rowscount1 = Cells(Rows.Count, 1).End(xlUp).Row
         temp1 = 0

              For i = 2 To (rowscount1)
           'Counting the number of cells which value greater than zero
                  If Cells(i, 10) > 0 Then
                  temp1 = temp1 + 1
                  End If
              Next i

 'Summing up the values which are above the current cell and in Sheet1, this inclues negative numbers as well

             Cells(rowscount + 1, 9).Value = Application.Sum(Range(Cells(1, 9), Cells(rowscount, 9)))
             Cells(rowscount + 2, 9) = temp
             'copy ke sheet 1
             Worksheets("Sheet1").Cells(K, 1).Value = Cells(rowscount + 1, 1).Value
             Worksheets("Sheet1").Cells(K, 2).Value = temp
             K = K + 1

             Cells(rowscount1 + 1, 10).Value = Application.Sum(Range(Cells(1, 10), Cells(rowscount1, 10)))
             Cells(rowscount1 + 2, 10) = temp1
             'copy ke sheet 1
             Worksheets("Sheet1").Cells(rowscount1 + K, rowscount1 + 1).Value = Cells(rowscount1 + 2, 1).Value
             Worksheets("Sheet1").Cells(rowscount1 + K, rowscount1 + 2).Value = temp1
             K = K + 1

             End If

Next ws

End Sub

i know my code is a mess and i wrote comment in every step i did so that i know what the codes are doing. i use different code for column I and J but neither works :(. any help will be appreciated, thanks in advance for your attention.

===========================================================================================

the code must be run in every sheet (except sheet1) manualy, so im still trying to make the code run from sheet1 but work on any other sheet in same workbook. any help will be appreciated, thanks in advance for your attention.

Sub Copy_Sum()

Dim ws As Worksheet
'Selecting the worksheets to loop through
K = 1
For Each ws In ThisWorkbook.Worksheets
'Skiping the sheet1
    If ws.Name <> "Sheet1" Then
'Counting the number of rows for automation
         rowsCount = Cells(Rows.Count, 1).End(xlUp).Row
         temp = 0
'Looping throught the cells for the calculation
             For j = 2 To (rowsCount)
           'Counting the number of cells which value greater than zero
                  If Cells(j - 1, 1) > 0 Then
                  temp = temp + 1
                  End If
              Next j
 'Summing up the values which are above the current cell and in Sheet1, this inclues negative numbers as well

             Cells(rowsCount + 1, 1).Value = Application.Sum(Range(Cells(1, 1), Cells(rowsCount, 1)))
             Cells(rowsCount + 1, 2) = temp
             Worksheets("Sheet1").Cells(K, 1).Value = Cells(rowsCount + 1, 1).Value
             Worksheets("Sheet1").Cells(K, 2).Value = temp
             K = K + 1
             End If

Next ws

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM