|
反向操作。。。
- Sub ykcbf() '//2024.11.12
- Application.ScreenUpdating = False
- Set ws = ThisWorkbook 'ws
- p = ws.Path & "" 'ws
- With Application.FileDialog(msoFileDialogFilePicker)
- .InitialFileName = p
- .Title = "请选择对应Excel文件"
- .AllowMultiSelect = False
- .Filters.Clear
- .Filters.Add "Excel文件", "*.xls*"
- If .Show Then f = .SelectedItems(1) Else Exit Sub
- End With
- Set wb = Workbooks.Open(f, 0) 'wb
- On Error Resume Next
- With ws 'ws
- For Each sh In .Sheets
- If Val(sh.Name) Then
- arr = sh.UsedRange
- Set sht = wb.Sheets(sh.Name)
- If Err <> 0 Then
- Set sht = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
- sht.[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
- sht.Name = sh.Name
- Else
- sht.Cells.ClearContents
- sht.[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
- sht.Name = sh.Name
- End If
- End If
- Next
- End With
- wb.Close 1
- Application.ScreenUpdating = True
- MsgBox "OK!"
- End Sub
复制代码
|
|