Я новичок в программировании и самоучка, поэтому прошу прощения за мое невежество и ошибки.Я пытаюсь написать макрос, чтобы найти непустые ячейки в столбце 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 во вновь созданную строку.