ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¤u§@ªí¥t¦s®É, ¨ú®ø­«ÂЦsÀÉ¥X¿ù

[µo°Ý] ¤u§@ªí¥t¦s®É, ¨ú®ø­«ÂЦsÀÉ¥X¿ù

¥»©«³Ì«á¥Ñ missbb ©ó 2024-1-7 23:11 ½s¿è

¤U¦CCODE, §Ú±N¤u§@ªí¥t¦s·sÀÉ, ¦ý·í¦sÀɮɦ³¬Û¦P¦WºÙªºÀÉ®×, §Ú¿ï¾Ü¤£¦sÀÉ, µ{¦¡¤´·|¦sÀɦbACTIVE WORKBOOKªºPATH, ©M¥X²{¤w"¤w¸g·s¼WÀÉ®×".

§Ú·Q¦pªG¿ï¾Ü¤£­«ÂЦsÀÉ, ª½±µ°h¥Xµ{¦¡, Åã¥Ü°T®§"¤w¸g¨ú®ø­«ÂЦsÀÉ", ¬O¦p¦ó§ïCODE©O? ÁÂÁÂ! TEST FILE SAVE.zip (18.08 KB)
  1. Sub saveactivesheet2()
  2. '¥Ø«e¤u§@ªí¥t¦s«ü©w¦ì¸m©MÀÉ«ö¦WºÙ

  3. Application.ScreenUpdating = False
  4. 'Application.DisplayAlerts = False

  5. Dim currentworkbook As Workbook
  6. Dim newworkbook As Workbook
  7. Dim currentworksheet As Worksheet
  8. Dim newworkbookname As String
  9. Dim fPath As String

  10. Set currentworkbook = ThisWorkbook
  11. Set currentworksheet = ActiveSheet

  12. newworkbookname = ActiveSheet.Range("S2").Value
  13. fPath = ActiveSheet.Range("S3").Value

  14. Set newworkbook = Workbooks.Add
  15. currentworksheet.Copy before:=newworkbook.Sheets(1)

  16. Range("A1:G100").Select
  17.     Selection.Copy
  18.     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
  19.         xlNone, SkipBlanks:=False, Transpose:=False
  20.     Columns("H:Y").Select
  21.     Application.CutCopyMode = False
  22.     Selection.Delete Shift:=xlToLeft
  23.     Range("A1").Select
  24.     ActiveWorkbook.Save

  25. On Error Resume Next

  26. newworkbook.SaveAs Filename:=fPath & "\" & newworkbookname

  27. newworkbook.Close

  28. 'Since nothing changed on sheet, provide feedback to user
  29.     MsgBox "¤w¸g·s¼WÀÉ®×"




  30. End Sub

  31.    
  32.    
½Æ»s¥N½X

¦^´_ 2# Andy2483
·Q½Ð¸û§A·s¼WªºCODEÀ³©ñ¦b§ÚªºCODE¨º¤@­Ó¦ì¸m? §Ú©ñ¦bON ERROR RESUME NEXT¤§¤U, §Y¨Ï¤£¬Ó½Æ¦sÀÉ, ³£¬O¥X²{ MsgBox "¤w¸g·s¼WÀÉ®×".

ÁÂÁ¸ѵª:D

TOP

ÁÂÁ¡A±zªº«ü¾É¤Q¤À¨ü¥Î

TOP

        ÀR«ä¦Û¦b : °ß¨ä´L­«¦Û¤vªº¤H¡A¤~§ó«i©óÁY¤p¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD