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

mklgxw1f  于 7个月前  发布在  其他
关注(0)|答案(1)|浏览(48)

我把一个文件分成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

字符串
我需要拆分的文件有从原来的列格式的电子邮件。

qlzsbp2j

qlzsbp2j1#

  • 更改标有**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

字符串

相关问题