求助：把当前工作表的部分内容，复制数值到新建工作簿

gyll

把当前工作表的部分内容，复制数值到新建工作簿中，新表以“待用”加时间命名

taller

参考代码

1. Sub CreateNew()
   
2.     Sheets("考场打印").Copy
   
3.     With ActiveSheet
   
4.         .Columns("A:F").Formula = .Columns("A:F").Value
   
5.         .Name = Format(Date, "YYYYMMDD")
   
6.     End With
   
7.     ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\New.xlsx", _
   
8.         FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
   
9. End Sub
   

复制代码

gyll

taller 发表于 2018-2-21 12:43
参考代码

感谢感谢。两个问题还请帮忙，一是复制过去的是整张表，不是指定的列，我想要的是只是复制指定的列。二是，我好像没说清，我希望新工作簿的名称是：“待用'后面加年月日时分秒。三是，新表不显示，回到原表窗口

taller

1. Sub CreateNew()
   
2.     Application.ScreenUpdating = False
   
3.     Set WK = Workbooks.Add
   
4.     ActiveSheet.Columns("A:F").Formula = Sheets("考场打印").Columns("A:F").Value
   
5.     WK.SaveAs Filename:=ThisWorkbook.Path & "\备用" & Format(Now, "YYYYMMDD_HHMMSS") & ".xlsx", _
   
6.         FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
   
7.     WK.Close
   
8.     Application.ScreenUpdating = True
   
9. End Sub
   

复制代码

gyll

taller 发表于 2018-2-21 13:00

没通过，显示下标越界？

taller

ActiveSheet.Columns("A:F").Formula = Thisworkbook.Sheets("考场打印").Columns("A:F").Value

gyll

taller 发表于 2018-2-21 15:11
ActiveSheet.Columns("A:F").Formula = Thisworkbook.Sheets("考场打印").Columns("A:F").Value

十分感谢，通过成功了

gyll

taller 发表于 2018-2-21 15:11
ActiveSheet.Columns("A:F").Formula = Thisworkbook.Sheets("考场打印").Columns("A:F").Value

再次向版主老师求助，怎么能直接让复制出的新表，按A列升序排列

taller

gyll 发表于 2018-2-21 20:36
再次向版主老师求助，怎么能直接让复制出的新表，按A列升序排列

在Excel中排序时录制代码，添加到代码过程中

gyll

taller 发表于 2018-2-22 00:05
在Excel中排序时录制代码，添加到代码过程中

1. Sub CreateNew()
   
2.     Application.ScreenUpdating = False
   
3.     Dim wk As Workbook
   
4.     Set wk = Workbooks.Add
   
5.     ActiveSheet.Columns("A:d").Formula = ThisWorkbook.Sheets("考场打印").Columns("A:d").Value
   
6.     wk.SaveAs Filename:=ThisWorkbook.Path & "\打印标签用" & Format(Now, "YYYYMMDD_HHMMSS") & ".xlsx", _
   
7.         FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
   
8.     wk.Close
   
9.    
   
10.     ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    
11.     ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A24") _
    
12.         , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
13.     With ActiveWorkbook.Worksheets("Sheet1").Sort
    
14.         .SetRange Range("A1:D24")
    
15.         .Header = xlYes
    
16.         .MatchCase = False
    
17.         .Orientation = xlTopToBottom
    
18.         .SortMethod = xlPinYin
    
19.         .Apply
    
20.     End With
    
21.    
    
22.    
    
23.     Application.ScreenUpdating = True
    
24. End Sub
    

复制代码

加上了，中间一段，可是，显示下标越界。我想旧表不动，只是新表按照A列升序，请老师抽时间帮我看看