我把一个文件分成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
字符串
我需要拆分的文件有从原来的列格式的电子邮件。
1条答案
按热度按时间qlzsbp2j1#
**change**
的两行字符串