Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Using VBA for a cycle loop between sheets of an excel file

I'm very new to VBA and have a question. Sorry if it sounds really basic. I will appreciate any help. I have an excel file having 9 sheets (Names: Total, 0, 3, 6, 9, 12, 15, 18, 21). First, I want to copy the second row of each sheet in order from sheets "0", "3", "6", "9", "12", "15", "18", "21" and paste them in rows "A2:X2" to "A9:X9" of sheet "Total". Then I want to repeat this with third rows, fourth rows, until the 365th row.

The most simple code for the first two sections will be like this but I want to write it like a loop using (for) or any other things to make it easy to use.

Sub Copy_rows()
' copying the second rows:
Worksheets("0").Range("A2:X2").Copy Worksheets("Total").Range("A2:X2")
Worksheets("3").Range("A2:X2").Copy Worksheets("Total").Range("A3:X3")
Worksheets("6").Range("A2:X2").Copy Worksheets("Total").Range("A4:X4")
Worksheets("9").Range("A2:X2").Copy Worksheets("Total").Range("A5:X5")
Worksheets("12").Range("A2:X2").Copy Worksheets("Total").Range("A6:X6")
Worksheets("15").Range("A2:X2").Copy Worksheets("Total").Range("A7:X7")
Worksheets("18").Range("A2:X2").Copy Worksheets("Total").Range("A8:X8")
Worksheets("21").Range("A2:X2").Copy Worksheets("Total").Range("A9:X9")

'Copying the third rows:
Worksheets("0").Range("A3:X3").Copy Worksheets("Total").Range("A10:X10")
Worksheets("3").Range("A3:X3").Copy Worksheets("Total").Range("A11:X11")
Worksheets("6").Range("A3:X3").Copy Worksheets("Total").Range("A12:X12")
Worksheets("9").Range("A3:X3").Copy Worksheets("Total").Range("A13:X13")
Worksheets("12").Range("A3:X3").Copy Worksheets("Total").Range("A14:X14")
Worksheets("15").Range("A3:X3").Copy Worksheets("Total").Range("A15:X15")
Worksheets("18").Range("A3:X3").Copy Worksheets("Total").Range("A16:X16")
Worksheets("21").Range("A3:X3").Copy Worksheets("Total").Range("A17:X17")

End Sub

Thank you in advance.

like image 899
Amin Avatar asked Aug 15 '21 11:08

Amin


People also ask

How do you loop through Excel sheets in VBA?

Use the following steps: First, declare a variable to refer to a worksheet for the loop. After that, start the loop with the keyword “For Each” and refer to each worksheet in the workbook. Now let's say you want to enter a value in the cell A1 of each worksheet you can use write code like following.

How do you cycle through sheets in Excel?

These keyboard shortcuts are probably the quickest and easiest way to move between sheets in Excel. Simply press CTRL + PAGE UP to move to the previous sheet, or CTRL + PAGE DOWN to move to the next sheet. You can also hold down the CTRL key and use the mouse scroll wheel to move between sheets.


1 Answers

Logic

  1. Look for trends. For example worksheet names.. 0-3-6...21. It increments by 3.
  2. Rows numbers are fixed. 2 To 365
  3. Instead of copying in a loop, store the values in an array and then output the array in one go. It will be SUPERFAST.
  4. There are 364 rows, 24 columns per sheet and 8 sheets in total. So you need 364 * 8 row array with 24 columns to store the data.

Code

Try this. This code took less than a second to run.

Option Explicit

Sub Sample()
    Dim Ar As Variant
    Dim TotalRows As Long
    
    '~~> 364 rows per sheet * 8 sheets
    TotalRows = 364 * 8
    ReDim Ar(1 To TotalRows, 1 To 24)
    
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim rw As Long: rw = 1
    
    '~~> Loop through the rows
    For j = 2 To 365
        '~~> Loop through 8 worksheets from 0 to 21
        For i = 0 To 21 Step 3
            '~~> Loop through the columns
            For k = 1 To 24
                Ar(rw, k) = Worksheets(CStr(i)).Cells(j, k).Value
            Next k
            '~~> Increment row in array
            rw = rw + 1
      
        Next i
    Next j
    
    '~~> Output to total worksheet
    Worksheets("Total").Range("A2").Resize(UBound(Ar), 24).Value = Ar
End Sub

To test, I used this Sample File. Run the code Sample in Module1

like image 157
Siddharth Rout Avatar answered Oct 16 '22 02:10

Siddharth Rout