Sub 宏2()
'
' 宏2 宏
'
'复制标题行
Range("A1:T1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("类别1.xlsx").Activate
Range("A1").Select
ActiveSheet.Paste
Windows("类别2.xlsx").Activate
Range("A1").Select
ActiveSheet.Paste
Windows("工作簿1.xlsx").Activate
s1 = 2
s2 = 2
For i = 2 To 65536
rg = "T" & i
If Range(rg).Text <> "" Then
If Range(rg).Text = 1 Then '类别为1
rg = "A" & i & ":T" & i
Range(rg).Select
Application.CutCopyMode = False
Selection.Copy
Windows("类别1.xlsx").Activate
rg = "A" & s1
Range(rg).Select
ActiveSheet.Paste
Windows("工作簿1.xlsx").Activate
s1 = s1 + 1
End If
If Range(rg).Text = 2 Then '类别为2
rg = "A" & i & ":T" & i
Range(rg).Select
Application.CutCopyMode = False
Selection.Copy
Windows("类别2.xlsx").Activate
rg = "A" & s2
Range(rg).Select
ActiveSheet.Paste
Windows("工作簿1.xlsx").Activate
s2 = s2 + 1
End If
If Range(rg).Text = 3 Then '类别为3
rg = "A" & i & ":T" & i
Range(rg).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
i = i - 1
End If
Else
Exit For
End If
Next
End Sub
在线交流,望采纳。工作薄名分别为:工作簿1,类别1,类别2。要求先打开。是xlsx格式的。
好吧,我还是按你的附件做了一个,看附件。
Sub 分类别()
Dim W1Path, W1Row, W1Column
Dim O1(), O2(), oo1, oo2
W1Path = ThisWorkbook.Path
W1Row = Sheet1.UsedRange.Rows.Count
W1Column = Sheet1.UsedRange.Columns.Count
ReDim O1(1 To Application.WorksheetFunction.CountIf(Columns("T"), 1), 1 To W1Column - 1)
ReDim O2(1 To Application.WorksheetFunction.CountIf(Columns("T"), 2), 1 To W1Column - 1)
oo1 = 1: oo2 = 1
For i = 2 To W1Row
If Sheet1.Cells(i, "T") = 3 Then
Sheet1.Rows(i).Delete
i = i - 1
Else
If Sheet1.Cells(i, "T") = 1 Then
For y = 1 To W1Column - 1
O1(oo1, y) = Sheet1.Cells(i, y)
Next
oo1 = oo1 + 1
ElseIf Sheet1.Cells(i, "T") = 2 Then
For y = 1 To W1Column - 1
O2(oo2, y) = Sheet1.Cells(i, y)
Next
oo2 = oo2 + 1
End If
End If
Next
Dim owrow, arrs, arrss()
For z = 1 To 2
Workbooks.Open W1Path & "\类别" & z
Windows("类别" & z & ".xls").Activate
owrow = Sheets("sheet1").UsedRange.Rows.Count
If z = 1 Then
arrs = oo1
arrss() = O1()
Else
arrs = oo2
arrss() = O2()
End If
For x = 1 To arrs - 1
For y = 1 To W1Column - 1
Cells(x + owrow, y) = arrss(x, y)
Next
Next
Next
End Sub
假设 你的总表名字是商品 vba代码如下
Sub 分类()
Sheets("类别1").Cells.ClearContents
Sheets("类别2").Cells.ClearContents
Dim a As Range
b = 1
c = 1
e = Application.CountA(Range("a:a"))
For i = 1 To e
Set a = Range("t" & i)
If a = 1 Then
Rows(i).Select
Selection.Copy
Sheets("类别1").Select
Rows(b).Select
ActiveSheet.Paste
b = b + 1
Else
If a = 2 Then
Rows(i).Select
Selection.Copy
Sheets("类别2").Select
Rows(c).Select
ActiveSheet.Paste
c = c + 1
Else
If a = 3 Then
Rows(i).Select
Selection.Delete Shift:=xlUp
i = i - 1
End If
End If
End If
Sheets("商品").Select
Next
End Sub
不懂得 在HI我
没能理解你移到是复制还是剪切过去,可否讲明白点?
sm100e@qq.com