特定条件区域另存新文件

sunny_8848

见图，想将行数列数不定的单元格区域另存为一个单独的文件，文件名为非空区域下面列（B列单元格红色单元格），格式都比较一致，图示仅示例实际区域不止这些。不知道哪位能帮忙写个代码，看了论坛的拆分单元格，不合适

新建文件夹.rar (159.25 KB, 下载次数: 9)

2023-1-13 12:15 上传

点击文件名下载附件

ykcbf1100

指定范围数据另存。

liulang0808

Sub test()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set sh = Sheets("明细栏")
    arr = sh.UsedRange
    r = 1
    For j = 1 To UBound(arr)
        If arr(j, 1) = "图纸名称" Then
            sh.Copy
            ActiveSheet.UsedRange.Clear
            sh.Range(sh.Cells(r, 1), sh.Cells(j, UBound(arr, 2))).Copy ActiveSheet.[a1]
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & arr(j, 2) & ".xlsx"
            ActiveWorkbook.Close False
            r = j + 3
        End If
    Next j
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

liulang0808

附件内容供参考。。。。。。

lcluck2002

我好想同楼主说一下，表格能否规范一下呢？有的有标题，有的没有标题，序号是反过来的，标题与内容之间还有空格。这让我们这些强迫症患者情何以堪？

sunny_8848

lcluck2002 发表于 2023-1-13 12:44
我好想同楼主说一下，表格能否规范一下呢？有的有标题，有的没有标题，序号是反过来的，标题与内容之间还有 ...

这个是可以的，格式基本一致，至于序号，有些图纸带零件图，有些就一个明细栏，公司现有图纸导出来的。变化的是行列数（非空）区域

sunny_8848

ykcbf1100 发表于 2023-1-13 12:41
指定范围数据另存。

谢谢帮忙，拆分达到要求了，只是拆分后文件中的列宽行高变化了。拆分后的内容我需要插入到CAD图纸中，这个有一定的要求，还需要手工调整列宽和行高

sunny_8848

liulang0808 发表于 2023-1-13 12:43
附件内容供参考。。。。。。

多谢版主帮忙，拆分代码高效，还保留了格式

ykcbf1100

sunny_8848 发表于 2023-1-13 14:00
谢谢帮忙，拆分达到要求了，只是拆分后文件中的列宽行高变化了。拆分后的内容我需要插入到CAD图纸中，这 ...

按你求助的内容看，我已经满足你的要求。
如果要保留原格式，你求助时应该一次性说清楚。

sunny_8848

ykcbf1100 发表于 2023-1-13 15:34
按你求助的内容看，我已经满足你的要求。
如果要保留原格式，你求助时应该一次性说清楚。

是我没有考虑周全，谢谢您的帮忙