|
参与一下。。。
- Sub ykcbf() '//2024.9.13
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- Set d = CreateObject("Scripting.Dictionary")
- p = ThisWorkbook.Path & ""
- p1 = p & "生成数据"
- With Sheets("汇总")
- r = .Cells(Rows.Count, 1).End(3).Row
- arr = [a1].Resize(r, 2)
- For i = 4 To UBound(arr)
- s = arr(i, 1)
- d(s) = arr(i, 2)
- Next
- bm = .[b2].Value
- fn = d(bm)
- End With
- For Each sht In Worksheets
- If sht.Name <> "汇总" Then
- m = m + 1
- If m = 1 Then sht.Select Else sht.Select False
- End If
- Next
- ActiveWindow.SelectedSheets.Copy
- Set wb = ActiveWorkbook
- For Each sht In wb.Sheets
- sht.UsedRange.Value = sht.UsedRange.Value
- Next
- wb.SaveAs p1 & fn
- wb.Close
- Sheets("汇总").Activate
- Application.ScreenUpdating = True
- MsgBox "OK!"
- End Sub
复制代码
|
|