VBA练习-打开文件，添加选中项，生成新表

学习VBA,正好给财务制作一个小工具：

Sub 打开人员信息表()

    Dim wb As Workbook, c As Integer

    Set wb = Workbooks.Open("C:\Users\wzn\Documents\工作簿2.xlsx", , True)

    c = wb.Worksheets.Count

    If c <  Then wb.Worksheets.Add after:=Worksheets(Worksheets.Count)

    wb.Worksheets().Select

End Sub

Sub 添加选中人员()

    Dim fw As Worksheet, lw As Worksheet, fr As Integer, lr As Integer, rg As Range

    Set fw = ActiveSheet

    Set lw = Worksheets(Worksheets.Count)

    For Each rg In Selection

        fr = rg.Row

        If Range("a" & fr) = "" Or Range("b" & fr) = "" Then

            MsgBox "选中项不能是空值，请确认选中项后重试"

            Exit Sub

        End If

        lr = lw.Range("a65536").End(xlUp).Row +

        lw.Range("a" & lr) = Range("a" & fr)

        lw.Range("b" & lr) = Range("b" & fr)

    Next

    If lw.Range("a1") <> "姓名" Then

        lw.Range("a1") = "姓名"

        lw.Range("b1") = "卡号"

        lw.Range("c1") = "金额"

        With lw.Range("a1,b1,c1").Font

            .Name = "宋体"

            .Size =

            .Bold = True

        End With

    End If

    With lw.Range("a1").CurrentRegion

        .Borders.ColorIndex =

        .Columns.AutoFit

        .HorizontalAlignment = xlCenter

    End With

End Sub

Sub 导出添加人员()

    Dim lw As Worksheet, curBook As Workbook

    Set curBook = ActiveWorkbook

    Set lw = Worksheets(Worksheets.Count)

    lw.Move

    curBook.Close False

End Sub