返回列表 上一主題 發帖

[發問] 另存新檔 怎麼把欄寛跟列高也複製到新表格?

[發問] 另存新檔 怎麼把欄寛跟列高也複製到新表格?

另存新檔 怎麼把欄寛跟列高也複製到新表格?
另外請問怎麼吧值複製過去就好,不要公式?

1空白報價單.rar (50.07 KB)
  1. Sub EX()
  2. Set xSh = Sheets("報價單")
  3. Set zSh = Sheets("請款單")

  4. iPath$ = ActiveWorkbook.Path & "\" '指定路徑"
  5. NewName$ = Format(Now, "yyyymmddhhmmss") & CStr([查表!C4])
  6. Set ibook = ActiveWorkbook
  7. With Workbooks.Add: ibook.Activate
  8.   [報價單!A1:I45].Copy .Sheets(1).[A1]: .Sheets(1).Name = "報價單"
  9.   [請款單!A1:I45].Copy .Sheets(2).[A1]: .Sheets(2).Name = "請款單"
  10.   .SaveAs iPath & NewName: .Close True

  11. End With: Set ibook = Nothing


  12. End Sub
複製代碼
excel學習中!築出夢想
https://www.youtube.com/channel/UCi1tIZdjAZ3xn-SehmmOKtQ

本帖最後由 n7822123 於 2019-11-23 01:55 編輯

回復 1# kkooo15


整頁複製過去應該比較快..........不用再設定欄寬列高

去掉公式很簡單,就原地複製+貼上值

順便幫你把按鈕砍掉,你新表格應該也不想有按鈕

Sub EX2()
Set xSh = Sheets("報價單")
Set zSh = Sheets("請款單")

iPath$ = ActiveWorkbook.Path & "\" '指定路徑"
NewName$ = Format(Now, "yyyymmddhhmmss") & CStr([查表!C4])
Set ibook = ActiveWorkbook
With Workbooks.Add: ibook.Activate
xSh.Copy before:=.Sheets(1)
  With ActiveSheet
    .UsedRange.Copy
    .[A1].PasteSpecial Paste:=xlPasteValues
    .Shapes(1).Delete
  End With
  zSh.Copy after:=.Sheets(1)
  With ActiveSheet
    .UsedRange.Copy
    .[A1].PasteSpecial Paste:=xlPasteValues
    .Shapes(1).Delete
  End With

  .SaveAs iPath & NewName: .Close True
  
End With: Set ibook = Nothing
End Sub
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 2# n7822123
太感謝了。
原來我把簡單的事複雜化了
excel學習中!築出夢想
https://www.youtube.com/channel/UCi1tIZdjAZ3xn-SehmmOKtQ

TOP

Sub EX()
Dim Sht As Worksheet, xB As Workbook, N%
Application.ScreenUpdating = False
Set xB = Workbooks.Add
ThisWorkbook.Activate
For Each Sht In Sheets(Array("報價單", "請款單"))
    With Sht.Cells: .Locked = True: .FormulaHidden = True: End With
    Sht.Protect: N = N + 1
    With xB.Sheets(N): Sht.Cells.Copy .[A1]: .Name = Sht.Name: End With
    Sht.Unprotect
Next
xB.SaveAs ThisWorkbook.Path & "\" & Format(Now, "yyyymmddhhmmss") & [查表!C4], CreateBackup:=False
xB.Close
End Sub

1)將儲存格格式設為:鎖定(V)+隱藏(V)
2)複製時,將工作表設為〔保護〕,完成後再〔解除保護〕
3)這樣,公式只會貼到值,按鈕物件也不會複製過去
 
 
========================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

本帖最後由 kkooo15 於 2019-11-24 02:15 編輯

回復 4# 准提部林

新點陣圖影像.png
2019-11-24 02:13

大大我用了你的方式,可是按扭還是會過去也
  是不是我用錯了什麼地方?

1空白報價單.rar (50.46 KB)
excel學習中!築出夢想
https://www.youtube.com/channel/UCi1tIZdjAZ3xn-SehmmOKtQ

TOP

回復 5# kkooo15

可能版本不同的關係吧! 我是用2000版,
那就多一行刪物件:
Sub EX()
Dim Sht As Worksheet, xB As Workbook, N%
Application.ScreenUpdating = False
Set xB = Workbooks.Add
ThisWorkbook.Activate
For Each Sht In Sheets(Array("報價單", "請款單"))
    With Sht.Cells: .Locked = True: .FormulaHidden = True: End With
    Sht.Protect: N = N + 1
    With xB.Sheets(N)
         Sht.Cells.Copy .[A1]
        .Name = Sht.Name
        .DrawingObjects.Delete '刪除物件
    End With
    Sht.Unprotect
Next
xB.SaveAs ThisWorkbook.Path & "\" & Format(Now, "yyyymmddhhmmss") & [查表!C4], CreateBackup:=False
xB.Close
End Sub


==============================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

Sub EX3()
Dim FN$, Sht As Worksheet, xB As Workbook
FN = ThisWorkbook.Path & "\" & Format(Now, "yyyymmddhhmmss") & [查表!C4]
Set xB = Workbooks.Add
For Each Sht In ThisWorkbook.Sheets(Array("報價單", "請款單"))
    Sht.Copy Before:=xB.Sheets(1)
    With xB.Sheets(1)
         .UsedRange.Value = .UsedRange.Value
         .DrawingObjects.Delete
    End With
Next
xB.SaveAs FN, CreateBackup:=False: xB.Close
End Sub


=================================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 6# 准提部林

我的是2010
用第一個程式碼會跳出這樣
1574817057762.jpg
2019-11-27 09:49

第二個就正常..
excel學習中!築出夢想
https://www.youtube.com/channel/UCi1tIZdjAZ3xn-SehmmOKtQ

TOP

        靜思自在 : 天上最美是星星,人生最美是溫情。
返回列表 上一主題