在VBA中拆分文件时需要抓取Excel列格式

Need to grab Excel column format when splitting file in VBA

提问人:user16201107 提问时间:11/3/2023 最后编辑:user16201107 更新时间:11/3/2023 访问量:44

问:

我将一个文件拆分为 500 行,并为每个行创建一个新文件。但是,我的文件有需要以特定方式格式化的列(文本和日期)。

谁能帮我在代码中添加一些东西,以便在创建拆分文件时从原始文件中获取列格式?

这是我的工作代码:

Sub dividerows()

Dim ACS As Range, Z As Long, New_WB As Workbook, _
Total_Columns As Long, Start_Row As Long, Stop_Row As Long, Copied_Range As Range

Dim Headers() As Variant
Dim AC As String: AC = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)
'Dim AC As String: AC = ActiveWorkbook.Name This is the old way it was done. Replace with the above piece of code that removes the extension completely.



Set ACS = ActiveSheet.UsedRange

With ACS

    Headers = .Rows(1).Value
    Total_Columns = .Columns.Count
    
End With

Start_Row = 2

Do While Stop_Row <= ACS.Rows.Count
    
    Z = Z + 1
    
    If Z > 1 Then Start_Row = Stop_Row + 1
    
    Stop_Row = Start_Row + 499
    
    With ACS.Rows
        If Stop_Row > .Count Then Stop_Row = .Count
    End With
    
    With ACS
        Set Copied_Range = .Range(.Cells(Start_Row, 1), .Cells(Stop_Row, Total_Columns))
    End With
    
    Set New_WB = Workbooks.Add
    
    With New_WB
    
        With .Worksheets(1)
            .Cells(1, 1).Resize(1, Total_Columns) = Headers
            .Cells(2, 1).Resize(Copied_Range.Rows.Count, Total_Columns) = Copied_Range.Value
        End With
        
       .SaveAs ACS.Parent.Parent.Path & Application.PathSeparator & AC & "_Part" & Z & ".xlsx", FileFormat:=51
       .Close
       
    End With
    
    If Stop_Row = ACS.Rows.Count Then Exit Do
    
Loop

End Sub

我需要拆分文件具有原始工作表的列格式。

Excel VBA 函数 文件拆分

评论


答:

0赞 taller 11/3/2023 #1
  • 更改标有**change**
    With New_WB
    
        With .Worksheets(1)
            ACS.Rows(1).Copy .Cells(1, 1)  ' **change**
            Copied_Range.Copy .Cells(2, 1)  ' **change**
        End With
        
       .SaveAs ACS.Parent.Parent.Path & Application.PathSeparator & AC & "_Part" & Z & ".xlsx", FileFormat:=51
       .Close
       
    End With