Поиск непустой ячейки, вставьте строку ниже, диапазон обрезки и вставку во вставленную строку - PullRequest
0 голосов
/ 24 мая 2018

Я новичок в программировании и самоучка, поэтому прошу прощения за мое невежество и ошибки.Я пытаюсь написать макрос, чтобы найти непустые ячейки в столбце F Строки с 1 по 1000 (F1: F1000), затем (при наличии данных) вставить строку под значением, затем вырезать значения из столбца F через J ивставьте значения во вновь созданные строки из столбца A в E. Затем он перейдет к следующей непустой ячейке в столбце F и повторите.Как только это будет сделано со столбцом F, он перейдет к столбцу K Строки от 1 до 1000, если данные присутствуют, вставьте строку под значением, затем обрежьте значения из столбца K через O и вставьте значения во вновь созданные строки из столбца A вE. Это будет повторяться так через столбец IP (найти что-то в столбце IE, вставить строку ниже и вырезать значения из IE в IP и вставить в A: E.

Мой код ниже. Любая помощь будет признательна.

Sub JW_Barcode()

Application.Calculation = xlCalculationManual

Dim rng As Range
For Each rng In Range("F1:F1000")
    If rng.Value <> "" Then
        rng.Offset(1, 0).EntireRow.Insert
    End If
Next
Dim a As Integer
For a = 1 To 1000
On Error GoTo NextColumn
With Columns("F:J")
    .Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With
Selection.Cut
With Columns("A:E")
    .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With
ActiveSheet.Paste
Next a
NextColumn:

Dim rng2 As Range
For Each rng2 In Range("K1:K1000")
    If rng2.Value <> "" Then
        rng2.Offset(2, 0).EntireRow.Insert
    End If
Next
Dim b As Integer
For b = 1 To 1000
On Error GoTo NextColumn2
With Columns("K:O")
    .Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With
Selection.Cut
With Columns("A:E")
    .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With
ActiveSheet.Paste
Next b
NextColumn2:

И т. Д. ... пока не будет найдено значение в столбце IE, вырежьте IE: IP и вставьте A: E во вновь созданную строку.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...