拆分工作薄的问题

谢玉红

附件 拆分工作薄附件.rar (472.03 KB, 下载次数: 12)

2023-5-17 07:32 上传

点击文件名下载附件

谢谢老师！

shiruiqiang

For x = 1 To 72 Step 2
Sheets.Name = x \ 2 + 1
这样拆分就行了

liulang0808

供参考

ykcbf1100

参与一下。

谢玉红

ykcbf1100 发表于 2023-5-17 08:38
参与一下。

老师你好，谢谢帮助。因后续操作需要  xlsb文件配套。看能否把另存为的文件改为  xlsb格式。再谢。

ykcbf1100

谢玉红 发表于 2023-5-17 10:20
老师你好，谢谢帮助。因后续操作需要  xlsb文件配套。看能否把另存为的文件改为  xlsb格式。再谢。

改好了。

谢玉红

ykcbf1100 发表于 2023-5-17 12:12
改好了。

老师你好，谢谢修改。试了一下，发现72行后出现乱码。如下图

谢玉红

liulang0808 发表于 2023-5-17 07:51
供参考

老师你好，麻烦看看哪里的问题。谢谢了。


Sub test()
  Application.ScreenUpdating = False
  Set sh = Sheets(1)
  r = sh.UsedRange.Rows.Count
  c = 1
  sh.Copy
  With ActiveSheet
      For j = 1 To 72 Step 2
          .UsedRange.Delete
          sh.Cells(1, j).Resize(r, 2).Copy.[a1]
          ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & c & ".xlsb", FileFormat:=xlExcel12, CreateBackup:=False
          c = c + 1
        Next j
  End With
  ActiveWorkbook.Close
  Application.ScreenUpdating = True
End Sub

gwjkkkkk

请参考 。。。

谢玉红

gwjkkkkk 发表于 2023-5-19 19:02
请参考 。。。

谢谢老师！完全符合要求。再谢。