帮同事做的。一个工作簿以为部门为名，里面有很多工作表，每个工作以姓名命名，为了统计方便将整个部门的数据处理成方便统计的列表。

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