Этот сценарий VBA у меня проходит по всем листам, но я не вижу вывод на всех листах. В чем будет причина?
Sub A()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Dim ct As String
ct = ws.Range("H4").Text
If InStr(1, ct, "CELL") Then
For Each B In ws.Range("B7:B49").Cells
If IsNumeric(B) And B <> "" Then
Cells(B.Row, 9) = Trim(Cells(B.Row + 1, 8)) & Trim(Cells(B.Row + 2, 8))
Cells(B.Row + 1, 8) = ""
Cells(B.Row + 2, 8) = ""
If B.Row > 50 Then Exit For
End If
Next B
For Each C In ws.Range("C1:C50").Cells
If Cells(C.Row, C.Column - 1) = "" Then
Cells(C.Row, C.Column) = ""
End If
Next C
For Each D In ws.Range("D1:D50").Cells
Cells(D.Row, D.Column) = ""
Next D
For Each E In ws.Range("E1:E50").Cells
Cells(E.Row, E.Column) = ""
Next E
For Each F In ws.Range("F1:F50").Cells
Cells(F.Row, F.Column) = ""
Next F
For Each G In ws.Range("G1:G50").Cells
Cells(G.Row, G.Column) = ""
Next G
For Each D In ws.Range("D1:D50").Cells
Cells(D.Row, D.Column) = Cells(D.Row, D.Column + 4)
Cells(D.Row, D.Column + 4) = ""
Next D
For Each E In ws.Range("E1:E50").Cells
Cells(E.Row, E.Column) = Cells(E.Row, E.Column + 4)
Cells(E.Row, E.Column + 4) = ""
Next E
End If
Dim cat As String
cat = ws.Range("I4").Text
If InStr(1, cat, "CELL") Then
For Each B In ws.Range("B7:B49").Cells
If IsNumeric(B) And B <> "" Then
Cells(B.Row, 10) = Trim(Cells(B.Row + 1, 9)) & Trim(Cells(B.Row + 2, 9))
Cells(B.Row + 1, 9) = ""
Cells(B.Row + 2, 9) = ""
If B.Row > 50 Then Exit For
End If
Next B
For Each C In ws.Range("C1:C50").Cells
If Cells(C.Row, C.Column - 1) = "" Then
Cells(C.Row, C.Column) = ""
End If
Next C
For Each D In ws.Range("D1:D50").Cells
Cells(D.Row, D.Column) = ""
Next D
For Each E In ws.Range("E1:E50").Cells
Cells(E.Row, E.Column) = ""
Next E
For Each F In ws.Range("F1:F50").Cells
Cells(F.Row, F.Column) = ""
Next F
For Each G In ws.Range("G1:G50").Cells
Cells(G.Row, G.Column) = ""
Next G
For Each M In ws.Range("H1:H50").Cells
Cells(M.Row, M.Column) = ""
Next M
For Each D In ws.Range("D1:D50").Cells
Cells(D.Row, D.Column) = Cells(D.Row, D.Column + 5)
Cells(D.Row, D.Column + 5) = ""
Next D
For Each E In ws.Range("E1:E50").Cells
Cells(E.Row, E.Column) = Cells(E.Row, E.Column + 5)
Cells(E.Row, E.Column + 5) = ""
Next E
End If
Dim cate As String
cate = ws.Range("J4").Text
If InStr(1, cate, "CELL") Then
For Each B In ws.Range("B7:B49").Cells
If IsNumeric(B) And B <> "" Then
Cells(B.Row, 11) = Trim(Cells(B.Row + 1, 10)) & Trim(Cells(B.Row + 2, 10))
Cells(B.Row + 1, 10) = ""
Cells(B.Row + 2, 10) = ""
If B.Row > 50 Then Exit For
End If
Next B
For Each C In ws.Range("C1:C50").Cells
If Cells(C.Row, C.Column - 1) = "" Then
Cells(C.Row, C.Column) = ""
End If
Next C
For Each D In ws.Range("D1:D50").Cells
Cells(D.Row, D.Column) = ""
Next D
For Each E In ws.Range("E1:E50").Cells
Cells(E.Row, E.Column) = ""
Next E
For Each F In ws.Range("F1:F50").Cells
Cells(F.Row, F.Column) = ""
Next F
For Each G In ws.Range("G1:G50").Cells
Cells(G.Row, G.Column) = ""
Next G
For Each M In ws.Range("H1:H50").Cells
Cells(M.Row, M.Column) = ""
Next M
For Each I In ws.Range("I1:I50").Cells
Cells(I.Row, I.Column) = ""
Next I
For Each J In ws.Range("J1:J50").Cells
Cells(J.Row, J.Column) = ""
Next J
For Each D In ws.Range("D1:D50").Cells
Cells(D.Row, D.Column) = Cells(D.Row, D.Column + 6)
Cells(D.Row, D.Column + 6) = ""
Next D
For Each E In ws.Range("E1:E50").Cells
Cells(E.Row, E.Column) = Cells(E.Row, E.Column + 6)
Cells(E.Row, E.Column + 6) = ""
Next E
End If
Next ws
End Sub
Что может быть причиной того, что он циклически перебирает листы и все же не производит вывод в [возрастах