第一个循环在两个循环之间中断，不会一直进行下去

Question

代码不会插入列，直到它找到范围内的所有列，因为它在到达第22列时停止，即使我还有6列可用，如果我在这里为代码For coly = 6 To 40 Step 4指定一个数字40来代替NewColsone，它就可以工作

Sub LatestCRDThree()
    Dim wb As Workbook, wb1 As Workbook
    Set wb = Workbooks("New CRD.xlsm")
    Set wb1 = Workbooks("A.xlsx")
    With wb.Worksheets("B")
        NewColsone = .UsedRange.Columns.Count
    End With

    With wb.Worksheets("B")
        .AutoFilterMode = False
        For coly = 6 To NewColsone Step 4 ' starting from 6th column enter a new column after consecutive 3 columns
            NewColsone = .UsedRange.Columns.Count
            Columns(coly).Insert Shift:=xlToRight
            NewColsone = NewColsone + 1
            Next coly
        End With
        For j = 6 To NewColsone Step 4
            If wb.Worksheets("B").Cells(2, j).Value = "" Then
                wb1.Worksheets("Required_Values").Range("A1").Copy Destination:=wb.Worksheets("B").Cells(2, j)
                wb1.Worksheets("Required_Values").Range("A5").Copy Destination:=wb.Worksheets("B").Cells(1, j)
            End If
            Next j
        End Sub

Answer 1

试一试

    coly = 6
    While NewColsone > coly
        Columns(Coly).Insert Shift:=xlToRight
        NewColsone = .UsedRange.Columns.Count
        coly = coly + 4
    Wend

而不是

For coly = 6 To NewColsone Step 4 ' starting from 6th column enter a new column after consecutive 3 columns
    NewColsone = .UsedRange.Columns.Count
    Columns(coly).Insert Shift:=xlToRight
    NewColsone = NewColsone + 1
Next coly