Question

它是一个简单的代码，可以转到工作表中，然后返回到第一张工作表并将其粘贴，然后重复，直到库存的A列中的值发生变化（新员工），此时需要进行一个新的工作表，开始存储新数据。并重复直到完成。

Dim i As Integer
Dim j As Integer

Set i = 2
Set j = 1
Do While i < 6
    Sheets("Inventory").Select
    If Cells("i,1").Value = Cells("i-1,1").Value Then
        Cells("i:i").Select
        Selection.Copy
        Sheets("Sheetj").Select
        Cells("i,1").Select
        Selection.Paste
        i = i + 1
    Else
        Sheets.Add After:=Sheets(Sheets.Count)
        j = j + 1
        Sheets("Inventory").Select
        Cells("i:i").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Sheetj").Select
        Range("A3").Select
        ActiveSheet.Paste
        i = i + 1
    End If

End Sub

Answer 1

添加：

Loop

在你结束之前。如果你引用我应该是的数字，我也不应该有双引号。应该像Cell（i，1）或Cells（i，i），我会让你解决剩下的问题。

抱歉，误读了原帖。固定的。

Answer 2

我会这样做为每个数据组添加创建新工作表。

更新：现在缩小我的代码“sheetj”部分是清晰的

码

Sub Other()   
Dim rng1 As Range
Dim rng2 As Range
Dim ws As Worksheet
Set rng1 = Sheets("Inventory").Range("I2:i6")
Set ws = Sheets.Add
For Each rng2 In rng1
    If rng2 <> rng2.Offset(-1, 0) Then Set ws = Sheets.Add
    rng2.EntireRow.Copy ws.Rows(rng2.Row)
Next
End Sub

Answer 3

Sub test()

Dim i As Integer
Dim j As Integer

i = 2 ' got rid of set
j = 1 ' got rid of set
Do While i < 6
    Sheets("Inventory").Select
    If Cells("i,1").Value = Cells("i-1,1").Value Then
        Cells("i:i").Select
        Selection.Copy
        Sheets("Sheetj").Select
        Cells("i,1").Select
        Selection.Paste
        i = i + 1
    Else
        Sheets.Add After:=Sheets(Sheets.Count)
        j = j + 1
        Sheets("Inventory").Select
        Cells("i:i").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Sheets" & j).Select ' for completeness...
        Range("A3").Select
        ActiveSheet.Paste
        i = i + 1
    End If
    Loop ' missing this


End Sub

Answer 4

未经测试，但我认为您使用了太多选择（尝试使用.activate？）

Dim i As long 'long is faster for loops
Dim j As long

i = 2 'dont need set 
j = 1
Do While i < 6
    with Sheets("Inventory")
       If .Cells(i,1).Value = .Cells(i-1,1).Value Then  'i removed the quotes in cells
           .range("i:i").Copy Sheets("Sheetj").Cells(i,1)
           i = i + 1
       Else
           Sheets.Add After:=Sheets(Sheets.Count)
           j = j + 1
           .Cells("i:i").copy Sheets("Sheetj").Range("A3")
           i = i + 1
       End If
    end with
    Application.CutCopyMode = False
loop  'you forgot a ending loop

Excel宏Do While循环不编译

4 个答案: