每个月初公司都会总结上个月的销售明细。店铺传过来的数据都会以下表的形式从销售系统中的报表导出Excel表。如果有缺失数据的，再由店铺传过来，由人工填补到表一里。数据补全后，需要以表二的数据整理一下再导回到销售系统里。通过手工复制粘贴做了好长一段时间，觉得太麻烦了。通长都会有上百家店铺的数据需要补全，这个工作量也不小了。后来想了想通过VBA来完成这个简单却又枯燥废时的工作。
思路是这样的：首先，在所有列之前插入一列用于填充店铺编码；其次，按照店铺的数据列数把日期块复制出相应的数量依次粘贴到下面的行里；再次，将数据依次复制到下面的行里；然后，把店铺编码依次填充到第一列里；最后，删除第三列往后的列和前三行以及无数据的行，最终达到表二的形式。
具体代码在表二之后。
表一：
| 店铺编码 | 2001 | 2002 | 2003 | 2004 |
| 店铺名称 | A | B | C | D |
| 回传次数 | 15 | 15 | 15 | 15 |
| 2008-9-1 | a | b | c | d |
| 2008-9-2 | a | b | c | d |
| 2008-9-3 | a | b | c | d |
| 2008-9-4 | a | b | c | d |
| 2008-9-5 | a | b | c | d |
| 2008-9-6 | a | b | c | d |
| 2008-9-7 | a | b | c | d |
| 2008-9-8 | a | b | c | d |
| 2008-9-9 | a | b | c | d |
| 2008-9-10 | a | b | c | d |
| 2008-9-11 | a | b | c | d |
| 2008-9-12 | a | b | c | d |
| 2008-9-13 | a | b | c | d |
| 2008-9-14 | a | b | c | d |
| 2008-9-15 | a | b | c | d |
表二：
| 2001 | 2008-9-1 | a |
| 2001 | 2008-9-2 | a |
| 2001 | 2008-9-3 | a |
| … | … | … |
| 2002 | 2008-9-1 | b |
| 2002 | 2008-9-2 | b |
| 2002 | 2008-9-3 | b |
| … | … | … |
| 2003 | 2008-9-1 | c |
| 2003 | 2008-9-2 | c |
| 2003 | 2008-9-3 | c |
| … | … | … |
| 2004 | 2008-9-1 | d |
| 2004 | 2008-9-2 | d |
| 2004 | 2008-9-3 | d |
| … | … | … |
VBA代码：
Sub CopyData()
Dim DateNum As Integer
Dim ColNum As Integer
Dim DateRange As Range
Dim StartRow As Integer
Dim EndRow As Integer
Dim PasteCell As Range
Application.ScreenUpdating = False
'在A列前插入一列用于输入店铺编码
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
DateNum = InputBox("请输入销售日期天数") '获得销售日期天数,即需要复制日期的行数
ColNum = InputBox("请输入数据列数量") '获得数据列数量,即需要将日期复制的次数
StartRow = 4 '定义开始行数
EndRow = DateNum + StartRow - 1 '计算结束行数
'按数据列数量,复制日期列
Dim i As Integer
For i = 1 To ColNum - 1
Range(Cells(4, 2), Cells(EndRow, 2)).Select
Selection.Copy
Cells(StartRow + DateNum * i, 2).Select
ActiveSheet.Paste
Range("B4").Select
Next i
Range("D4").Select
'复制数据列
Dim k As Integer
For k = 1 To ColNum - 1
Range(Cells(4, 3 + k), Cells(EndRow, 3 + k)).Select
Selection.Copy
Cells(StartRow + DateNum * k, 3).Select
ActiveSheet.Paste
Range("C4").Select
Next k
'复制店铺编码
Dim j As Integer
Dim ShopNum As String
For j = 1 To ColNum
ShopNum = Cells(1, j + 2)
Range(Cells(StartRow + DateNum * (j - 1), 1), Cells(StartRow + DateNum * j - 1, 1)) = ShopNum
Range("B4").Select
Next j
'删除旧表头(前三行)
Rows("1:3").Select
Selection.Delete Shift:=xlUp
'删除残留数据列
Range("A1").Select
Columns("D:IV").Select
Selection.Delete Shift:=xlToLeft
'删除无数据行
Dim m As Integer
Dim n As Integer
Dim MaxRow As Integer
MaxRow = DateNum * ColNum
n = 1
For m = 1 To MaxRow
If Cells(n, 3) = "" Then
Rows(n).Delete
n = n - 1
MaxRow = MaxRow - 1
End If
n = n + 1
Next m
'由于导入数据需要复制到特定的Excel（Menu）表里，所以这里多了一些语句是处理这一操作的
'复制数据块
Range(Cells(1, 1), Cells(MaxRow, 3)).Select
Selection.Copy
'切换到Menu工作簿,店铺销售工作表
Application.Workbooks("Menu.xls").Activate
Worksheets("店铺销售").Select
'将销售数据选择性粘贴到工作表里,并保存Menu工作簿
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'格式化日期列，因为选择性粘贴后，日期列变成了数字
Columns("B:B").Select
Selection.NumberFormatLocal = "yyyy-m-d"
ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub
以上代码各个部分相对来说比较独立，涉及的都是Excel表里比较简单的操作，如：复制，粘贴，删除行列，单元格格式化和选定单元格、行、列以及工作表、工作薄，理解起来比较容易。
