从一个表中按某个条件复制内容到另一个表中,代码如下:
Sub 按区域分表()
Dim i As Long
Dim j As Long
Dim k As Long
For i = 2 To Sheets(2).Cells(65536, 1).End(xlUp).Row
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheets(2).Cells(i, 1).Value
k = 1
For j = 2 To Sheets(1).Cells(65536, 1).End(xlUp).Row
If Sheets(1).Cells(j, 1).Value = Sheets(2).Cells(i, 1).Value Then
'复制该行内容
Sheets("sheet1").Activate
Sheets(1).Range("A" & j & ":F" & j&).Select
Selection.Copy
'粘贴到新表中
Sheets(Sheets.Count).Activate
'定位到新的一行
Range("A" & k&).Select
ActiveSheet.Paste
k = k + 1
End If
Next
Next
End Sub
每次都是
Range("A" & k&).Select
出错。
望高人指点。
Sub 按区域分表()
Dim i As Long
Dim j As Long
Dim k As Long
For i = 2 To Sheets(2).Cells(65536, 1).End(xlUp).Row
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheets(2).Cells(i, 1).Value
k = 1
For j = 2 To Sheets(1).Cells(65536, 1).End(xlUp).Row
If Sheets(1).Cells(j, 1).Value = Sheets(2).Cells(i, 1).Value Then
'复制该行内容
Sheets("sheet1").Activate
Sheets(1).Range("A" & j & ":F" & j&).Select
Selection.Copy
'粘贴到新表中
Sheets(Sheets.Count).Activate
'定位到新的一行
Range("A" & k&).Select
ActiveSheet.Paste
k = k + 1
End If
Next
Next
End Sub
每次都是
Range("A" & k&).Select
出错。
望高人指点。