Excel VBA Userform資料打完後，點集按鈕能夠貼上至指定工作表

michael811122
個人積分：2分
文章編號：78485401

2分

樓主

2020-07-27 21:00

我寫一個登打USERFORM，現在卡在一個問題上，就是
我這邊有一個登打用的工作表及工作表A、B、C
當我登打完畢後，選擇完我想要新增至的A、B、C其中之一的工作表後，點集下方設定的列印按鈕即可直接列印，並依照我選的其中之一工作表進行貼上並儲存

目前唯一遇到的問題是
卡在列印按鈕如何依照我選擇要貼上的工作表去做判定

Excel VBA Userform資料打完後，點集按鈕能夠貼上至指定工作表

以上圖為例
選擇的單位為TP698+TP699
打完兩行資料後點及列印希望可以判定貼上至工作表TP698+TP699中

程式碼如下
懇請各位大大教學求解，感恩
__________________________________________________________________
'列印區域
Private Sub PrintR_Click()

'單位選擇防呆
If Unit.Text = "" Then
MsgBox "請選擇單位!"
Exit Sub
End If

'列印範圍
'ActiveWorkbook.Save
'r = [C65536].End(xlUp).Row
'Do Until Cells(r, 3) <> ""
'r = r - 1
'Loop
'ActiveSheet.PageSetup.PrintArea = "A2:K" & r
'ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True, _
' IgnorePrintAreas:=False

'剪下內容貼至總表
Sheets("登打").Range("K2").Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut

'單位698+699
If Unit.Text = TP698 + TP699 Then

Sheets("TP698+TP699").Select
Range("A2").Select
If Sheets("TP698+TP699").Range("A2").Value = "" Then
Sheets("TP698+TP699").Range("A2").Select
Else
Selection.End(xlDown).Select
End If

Sheets("TP698+TP699").Range("A" & ActiveCell.Row + 1).Select
ActiveSheet.Paste
End If

'單位707
If Unit.Text = TP707 Then

'剪下內容貼至總表
Sheets("登打").Range("K2").Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut

Sheets("TP707").Select
Range("A2").Select
If Sheets("TP707").Range("A2").Value = "" Then
Sheets("TP707").Range("A2").Select
Else
Selection.End(xlDown).Select
End If

Sheets("TP707").Range("A" & ActiveCell.Row + 1).Select
ActiveSheet.Paste
End If

'儲存
ActiveWorkbook.Save
' Sheets("登打").Select

End Sub

2020-07-27 21:00 發佈

文章關鍵字 Excel VBA Userform 資料指定工作表按鈕

唬唬生瘋

唬唬生瘋
個人積分：7286分
文章編號：78502039

7286分

2樓

2020-07-29 8:01

有點看不懂問題
我個人會這樣做
一個獨立列印的資料表
其他就是真正儲存資料的分頁
在FORM裡面KEY好的資料同時貼到列印跟儲存頁面

小小尉

小小尉
個人積分：242分
文章編號：78506205

242分

3樓

2020-07-29 13:02

michael811122 wrote:
我寫一個登打USERFORM...(恕刪)

加入這一行 Worksheets("工作表名稱").Activate

'列印範圍
'Worksheets(Unit.Text).Activate
'ActiveWorkbook.Save
'r = [C65536].End(xlUp).Row
'Do Until Cells(r, 3) <> ""
'r = r - 1
'Loop
'ActiveSheet.PageSetup.PrintArea = "A2:K" & r
'ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True, _
' IgnorePrintAreas:=False

試試

michael811122

michael811122
個人積分：2分
文章編號：78512858

2分

樓主

2020-07-29 22:38

Worksheets(Unit.Text).Activate加入執行後會出現這個畫面

希望作業打表這個程式可以
EX:
打好單後->選擇單位->按下列印->1.開啟列印行為 2.剪下所有內容貼至選擇的單位
如下圖示範

欲能夠協助大大們了解
提供此檔案請大大懇請協助更改
https://drive.google.com/file/d/1gLEh2Rv51aXz_6RFU92eoRRwaQIjUUIN/view?usp=sharing

小小尉

小小尉
個人積分：242分
文章編號：78528422

242分

5樓

2020-07-31 8:17

檔案要權限才能下載...我就不下載了 sorry

下面程式碼試試，再自己修改一下



 '列印 區域
Private Sub PrintR_Click()

'單位選擇防呆
If Unit.Text = "" Then
MsgBox "請選擇單位!"
Exit Sub
End If

'列印範圍
'ActiveWorkbook.Save
'r = [C65536].End(xlUp).Row
'Do Until Cells(r, 3) <> ""
'r = r - 1
'Loop
'ActiveSheet.PageSetup.PrintArea = "A2:K" & r
'ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True, _
' IgnorePrintAreas:=False


'剪下內容貼至總表
Worksheets("登打").Activate
Sheets("登打").Range("K2").Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut

Select Case Unit.Text

Case "TP698+TP699"
Sheets("TP698+TP699").Select

Case "TP707"
Sheets("TP707").Select

End Select


Range("A2").Select
If Sheets(Unit.Text).Range("A2").Value = "" Then
Sheets(Unit.Text).Range("A2").Select
ActiveSheet.Paste
Else
Selection.End(xlDown).Select
Sheets(Unit.Text).Range("A" & ActiveCell.Row + 1).Select
ActiveSheet.Paste
End If

'儲存
ActiveWorkbook.Save
' Sheets("登打").Select

End Sub

michael811122

michael811122
個人積分：2分
文章編號：78542251

2分

樓主

2020-08-01 11:04

謝謝協助修改，可以正常剪貼了!
感動

目前最後一個問題
就是我這邊想要設定列印的標題內容
我想要列印的區域是登打的內容
範例:
單位選擇TP789 ->輸入10筆資料 -> 按下列印
希望結果:標題為TP789，列印10筆資料
目前結果:標題為TP789，列印TP789所有資料包含新增使筆

新打的程式碼如下:
'列印區域
Private Sub PrintR_Click()

'單位選擇防呆
If Unit.Text = "" Then
MsgBox "請選擇單位!"
Exit Sub
End If

'列印範圍
Worksheets(Unit.Text).Activate
ActiveWorkbook.Save

If Unit.Text = "TP698+TP699" Then

Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = "&""微軟正黑體,標準""&14單位：TP698+TP699"
.CenterHeader = "&""微軟正黑體,粗體""&16富日、富掬通訊處"
.RightHeader = "&""微軟正黑體,標準""&14窗口 : Mike峻瑋"
.LeftFooter = "&""微軟正黑體,粗體""Fubon 密件 "
.CenterFooter = "&""微軟正黑體,標準""&D"
.RightFooter = "&""微軟正黑體,標準"" 第 &P 頁"
.LeftMargin = Application.InchesToPoints(0.511811023622047)
.RightMargin = Application.InchesToPoints(0.511811023622047)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
End If

If Unit.Text = "TP707" Then

Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = "&""微軟正黑體,標準""&14單位：TP707"
.CenterHeader = "&""微軟正黑體,粗體""&16富華通訊處"
.RightHeader = "&""微軟正黑體,標準""&14窗口 : Mike峻瑋"
.LeftFooter = "&""微軟正黑體,粗體""Fubon 密件 "
.CenterFooter = "&""微軟正黑體,標準""&D"
.RightFooter = "&""微軟正黑體,標準"" 第 &P 頁"
.LeftMargin = Application.InchesToPoints(0.511811023622047)
.RightMargin = Application.InchesToPoints(0.511811023622047)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
End If

If Unit.Text = "TP789" Then

Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = "&""微軟正黑體,標準""&14單位：TP789"
.CenterHeader = "&""微軟正黑體,粗體""&16富鈺通訊處"
.RightHeader = "&""微軟正黑體,標準""&14窗口 : Mike峻瑋"
.LeftFooter = "&""微軟正黑體,粗體""Fubon 密件 "
.CenterFooter = "&""微軟正黑體,標準""&D"
.RightFooter = "&""微軟正黑體,標準"" 第 &P 頁"
.LeftMargin = Application.InchesToPoints(0.511811023622047)
.RightMargin = Application.InchesToPoints(0.511811023622047)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
End If

r = [C65536].End(xlUp).Row
Do Until Cells(r, 3) <> ""
r = r - 1
Loop
ActiveSheet.PageSetup.PrintArea = "A2:K" & r
ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True, _
IgnorePrintAreas:=False
_______________________________________________________________

Worksheets(Unit.Text).Activate
多了這行會直接列印選擇單位的全部內容，並會選擇的列印標題
少了這行會直接列印10筆登打之新增內容，並不會更改列印標題

目前已更新至最新檔案畫面

https://drive.google.com/file/d/1pIvRzLFq39U0sb3zvITM27mBKdJVT7d7/view?usp=sharing
上發連結了可以進行下載使用，懇請大大協助最後完成!

PS:想問一下因為在開啟VBA的情況下無法返回到EXCEL畫面做正常的編輯操作，往往我都要按下我自己做的離開按鈕來強制中斷STOP後再按下，VBA編輯區的停止才能正常操作使用，請問有什麼方法可以做一個按鈕直接停止所有VBA運行，回到正常編輯EXCEL的狀態嗎?
如圖

小小尉

小小尉
個人積分：242分
文章編號：78552371

242分

7樓

2020-08-02 13:40

michael811122 wrote:
謝謝協助修改，可以正...(恕刪)

1.列印標題不正確的問題，請將下列紅色部分刪除


'列印 區域
Private Sub PrintR_Click()

'單位選擇防呆
If Unit.Text = "" Then
MsgBox "請選擇單位!"
Exit Sub
End If

'列印範圍
Worksheets(Unit.Text).Activate
ActiveWorkbook.Save

If Unit.Text = "TP698+TP699" Then


Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = "&""微軟正黑體,標準""&14單位：TP698+TP699"
.CenterHeader = "&""微軟正黑體,粗體""&16富日、富掬通訊處"
.RightHeader = "&""微軟正黑體,標準""&14窗口 : Mike峻瑋"
.LeftFooter = "&""微軟正黑體,粗體""Fubon 密件 "
.CenterFooter = "&""微軟正黑體,標準""&D"
.RightFooter = "&""微軟正黑體,標準"" 第 &P 頁"
.LeftMargin = Application.InchesToPoints(0.511811023622047)
.RightMargin = Application.InchesToPoints(0.511811023622047)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
End If

If Unit.Text = "TP707" Then


Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = "&""微軟正黑體,標準""&14單位：TP707"
.CenterHeader = "&""微軟正黑體,粗體""&16富華通訊處"
.RightHeader = "&""微軟正黑體,標準""&14窗口 : Mike峻瑋"
.LeftFooter = "&""微軟正黑體,粗體""Fubon 密件 "
.CenterFooter = "&""微軟正黑體,標準""&D"
.RightFooter = "&""微軟正黑體,標準"" 第 &P 頁"
.LeftMargin = Application.InchesToPoints(0.511811023622047)
.RightMargin = Application.InchesToPoints(0.511811023622047)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
End If

If Unit.Text = "TP789" Then


Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = "&""微軟正黑體,標準""&14單位：TP789"
.CenterHeader = "&""微軟正黑體,粗體""&16富鈺通訊處"
.RightHeader = "&""微軟正黑體,標準""&14窗口 : Mike峻瑋"
.LeftFooter = "&""微軟正黑體,粗體""Fubon 密件 "
.CenterFooter = "&""微軟正黑體,標準""&D"
.RightFooter = "&""微軟正黑體,標準"" 第 &P 頁"
.LeftMargin = Application.InchesToPoints(0.511811023622047)
.RightMargin = Application.InchesToPoints(0.511811023622047)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
End If



r = [C65536].End(xlUp).Row
Do Until Cells(r, 3) <> ""
r = r - 1
Loop
ActiveSheet.PageSetup.PrintArea = "A2:K" & r
ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True, _
IgnorePrintAreas:=False

2.有什麼方法可以做一個按鈕直接停止所有VBA運行，這裡不用Stop


Private Sub CloseB_Click()
Stop
Unload Keyin10
End Sub

試試吧...檔案我就不改了，內容有點亂，有很多地方可能要修改((強迫症發作

michael811122

michael811122
個人積分：2分
文章編號：78555512

2分

樓主

2020-08-02 20:21

1.謝謝大大的協助，感動!!
2.因為若沒有設定stop在按上方重新設定方塊圖示的話會出現打不出中文亦或是打不出英文的狀況
而且一般按下ENTER 會跳下一個儲存格，會變成原儲存格往下一行，請問有其他辦法可以直接設定，直接關閉整個VBA嗎?
感謝大大的協助!

小小尉

小小尉
個人積分：242分
文章編號：78558752

242分

9樓

2020-08-03 8:04

michael811122 wrote:
1.謝謝大大的協助，...(恕刪)

試試改成這樣吧!


Private Sub CloseB_Click()
Unload Keyin10
End
End Sub

michael811122

michael811122
個人積分：2分
文章編號：78874607

2分

樓主

2020-08-29 14:34

想請教一下有時候我只有新增一筆要的資料但是在按下列印後，會列印只有一筆的資料，但是沒辦法只選擇一筆貼上至我想要貼上的累積表單區域，要如何更改程式碼，好讓只有單筆內容貼上時不要跳出錯誤訊息

程式碼內容如下
__________________________________________
'剪下內容貼至總表
Worksheets("登打").Activate
Sheets("登打").Range("K2").Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut

Select Case Unit.Text

Case "TP698+TP699"
Sheets("TP698+TP699").Select

Case "TP707"
Sheets("TP707").Select

Case "TP789"
Sheets("TP789").Select

End Select

Range("A2").Select
If Sheets(Unit.Text).Range("A2").Value = "" Then
Sheets(Unit.Text).Range("A2").Select
ActiveSheet.Paste
Else
Selection.End(xlDown).Select
Sheets(Unit.Text).Range("A" & ActiveCell.Row + 1).Select
ActiveSheet.Paste
End If

'儲存
ActiveWorkbook.Save
Sheets("登打").Select

End Sub