同事一个需求,如图数量列,如果是100就要复制100行,以此类推。每次都手动复制很累人,而且容易粘贴数量错误,因此我给他做了个vba来解决这个问题,代码如下:
Sub Macro1()
With Sheets("sheet1")
bth = 1 'sheet1的标题行号
hh = 2 'sheet1有数据的起始行号
lh = 14 'sheet1数量所在列号
'以下是复制标题行代码
Sheets("Sheet1").Select
Range("A" & bth & ":z" & bth).Select '获取要复制的标题行
Selection.Copy
Sheets("Sheet2").Select
Cells(1, 1).Rows.Select '定位sheet2第一行准备接收标题行
ActiveSheet.Paste '粘贴行
Cells(ActiveCell.Row + 1, 1).Rows.Select '目标表格光标下移动一行
'以下是复制数据行代码
Do While Sheet1.Range("A" & hh) > "" '如果A列有值就循环,直到最后
fzcs = .Cells(hh, lh).Value '将需要复制的次数给变量fzcs(复制次数)
Sheets("Sheet1").Select
Range("A" & hh & ":z" & hh).Select '获取要复制的数据行
Selection.Copy
Cells(ActiveCell.Row + 1, 1).Rows.Select '原始表格光标下移动一行,准备下次提取数据用
Sheets("Sheet2").Select
Do While fzcs > 0 '循环复制
ActiveSheet.Paste '粘贴行
Cells(ActiveCell.Row, lh) = 1
Cells(ActiveCell.Row + 1, 1).Rows.Select '目标表格光标下移动一行,准备下次接受数据用
fzcs = fzcs - 1
Loop
hh = hh + 1
Loop
End With
End Sub
联系客服