Это мой код:
'copy cells
Sub start()
'variable for all worksheets in the workbook
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim sh4 As Worksheet
Dim sh5 As Worksheet
Dim sh6 As Worksheet
Dim sh7 As Worksheet
Dim sh8 As Worksheet
Dim sh9 As Worksheet
Dim sh10 As Worksheet
Dim sh11 As Worksheet
Dim sh12 As Worksheet
Dim sh13 As Worksheet
Dim sh14 As Worksheet
Dim sh15 As Worksheet
Dim sh16 As Worksheet
Dim sh17 As Worksheet
Dim sh18 As Worksheet
Dim sh19 As Worksheet
Dim sh20 As Worksheet
Dim sh21 As Worksheet
Dim sh22 As Worksheet
Dim sh23 As Worksheet
Dim sh24 As Worksheet
Dim sh25 As Worksheet
Dim sh26 As Worksheet
Dim sh27 As Worksheet
Dim sh28 As Worksheet
Dim sh29 As Worksheet
Dim sh30 As Worksheet
Dim sh31 As Worksheet
Dim sh32 As Worksheet
Dim sh33 As Worksheet
Dim sh34 As Worksheet
Dim sh35 As Worksheet
Dim sh36 As Worksheet
Dim sh37 As Worksheet
Dim sh38 As Worksheet
Dim sh39 As Worksheet
Dim sh40 As Worksheet
'variable for the workbook itself
Dim wkb As Workbook
'set workbook
Set wkb = Workbooks("macro2.xlsm")
With wkb 'create with statement to call on worksheets
Set sh1 = .Sheets("1")
Set sh2 = .Sheets("2")
Set sh3 = .Sheets("3")
Set sh4 = .Sheets("4")
Set sh5 = .Sheets("5")
Set sh6 = .Sheets("6")
Set sh7 = .Sheets("7")
Set sh8 = .Sheets("8")
Set sh9 = .Sheets("9")
Set sh10 = .Sheets("10")
Set sh11 = .Sheets("11")
Set sh12 = .Sheets("12")
Set sh13 = .Sheets("13")
Set sh14 = .Sheets("14")
Set sh15 = .Sheets("15")
Set sh16 = .Sheets("16")
Set sh17 = .Sheets("17")
Set sh18 = .Sheets("18")
Set sh19 = .Sheets("19")
Set sh20 = .Sheets("20")
Set sh21 = .Sheets("21")
Set sh22 = .Sheets("22")
Set sh23 = .Sheets("23")
Set sh24 = .Sheets("24")
Set sh25 = .Sheets("25")
Set sh26 = .Sheets("26")
Set sh27 = .Sheets("27")
Set sh28 = .Sheets("28")
Set sh29 = .Sheets("29")
Set sh30 = .Sheets("30")
Set sh31 = .Sheets("31")
Set sh32 = .Sheets("32")
Set sh33 = .Sheets("33")
Set sh34 = .Sheets("34")
Set sh35 = .Sheets("35")
Set sh36 = .Sheets("36")
Set sh37 = .Sheets("37")
Set sh38 = .Sheets("38")
Set sh39 = .Sheets("39")
Set sh40 = .Sheets("40")
Set shsum = .Sheets("sum") 'name sheet to copy to
'add more if there are more sheets example
'set sh41 = .sheets("41")
'name first range to copy
sh1.Range("b8").copy shsum.Range("a2")
sh1.Range("b5").copy shsum.Range("b2")
sh1.Range("b4").copy shsum.Range("c2")
sh1.Range("G13:G30").copy shsum.Range("d2:d18")
sh1.Range("h13:h30").copy shsum.Range("e2:e18")
sh1.Range("i13:i30").copy shsum.Range("f2:f18")
sh1.Range("j13:j30").copy shsum.Range("g2:g18")
sh1.Range("k13:k30").copy shsum.Range("h2:h18")
End With
End Sub
Чтобы получить данные на 40 листах, мне нужно было бы вводить каждый лист с той же информацией, которую вы видите, и это тонна набора текста.
- Есть ли способ, которым я могу сделать какой-то массив для листов?
- Затем мне нужно пропустить 18 строк вниз для каждого дополнительного листа, чтобы не перекрывать данные в
sum
листе. Это связано с тем, что с g13 по k30 имеется 18 строк данных, которые необходимо заполнить. B8, b5 и b4 - это имя элемента (X
), номер (Y
) и номер (Z
), связанные с элементами, которые занимают g13 через K30 в каждой таблице. Мне нужно убедиться, что данные каждой электронной таблицы, скопированные вsum
таблицу суммы, содержат элементыX
,Y
иZ
в первой строке, за которыми следуют связанные элементы длиной 18 строк.