帮同事做的。一个工作簿以为部门为名，里面有很多工作表，每个工作以姓名命名，为了统计方便将整个部门的数据处理成方便统计的列表。
VBA:
Sub 数据导入()
For biao = 1 To Sheets.Count
If Sheets(biao).Name <> "数据表" Then
For lie = 2 To 51 Step 2
For hang = 4 To 15
Endr = Sheets("数据表").Cells(65536, 3).End(xlUp).Row + 1
If Sheets(biao).Cells(hang, lie) <> "" Then
Sheets("数据表").Cells(Endr, 2) = Sheets(biao).Name '姓名
Sheets("数据表").Cells(Endr, 3) = Sheets(biao).Cells(hang, 1).Value '月份
If Sheets(biao).Cells(1, lie) = "" Then '项目
Sheets("数据表").Cells(Endr, 4) = Sheets(biao).Cells(1, Sheets(biao).Cells(1, lie).End(xlToLeft).Column).Value
Else
Sheets("数据表").Cells(Endr, 4) = Sheets(biao).Cells(1, lie).Value
End If
If Sheets(biao).Cells(1, lie) = "套餐" Or Sheets(biao).Cells(1, lie - 1) = "套餐" Then
Sheets("数据表").Cells(Endr, 5) = "套餐"
ElseIf Sheets(biao).Cells(2, lie) = "" Then
Sheets("数据表").Cells(Endr, 5) = Sheets(biao).Cells(2, Sheets(biao).Cells(2, lie).End(xlToLeft).Column).Value
Else
Sheets("数据表").Cells(Endr, 5) = Sheets(biao).Cells(2, lie).Value
End If
Sheets("数据表").Cells(Endr, 6) = Sheets(biao).Cells(hang, lie).Value '次数
Sheets("数据表").Cells(Endr, 7) = Sheets(biao).Cells(hang, lie + 1).Value '金额
End If
Next hang
Next lie
End If
Next biao
End Sub
