iT邦幫忙

0

EXCEL無法複製工作表

各位大大,小弟的EXCEL突然無法複製工作表
本來是用VBA去複製到最後再改名字.代碼如下圖.結果他說無法複製.
https://ithelp.ithome.com.tw/upload/images/20210416/20122398jejSnKRgqe.png
之後我再建一個新檔,是可以複製的.
但是如果我運行過VBA就不行了(如下圖)另外我也試過在同一個XLM.內新建一個空白的工作表再複製是可以的,但我填入資料後就不行了,這是什麼問題呢?求各位幫忙.謝謝
https://ithelp.ithome.com.tw/upload/images/20210416/2012239846KfBzsqMu.png

我才開始接觸VBA,很多資料都是一個個的慢慢填.我在想如果我有一組東西要填的應該怎樣寫.
如:worksheets(1)的V4至AZ4要填到worksheets(2)的B13至AF13
worksheets(1)的BB4至CF4要填到worksheets(2)的B14至AF14

偵錯後黃標了這句
Worksheets(2).Copy after:=Sheets(Sheets.Count)

Sub fillup()

Worksheets(1).Range("B4").Activate

Dim name As String
Dim sex As String
Dim NRID As Double
Dim BD As Date
Dim Telno As String
Dim position As String
Dim joindate As Date
Dim otS As Double
Dim RDOS As Double
Dim SHS As Double
Dim other As String


Dim Salary As Double
Dim allowance As Double

Do Until ActiveCell = ""

name = Worksheets(1).Range(ActiveCell, ActiveCell).Value
sex = Worksheets(1).Range(ActiveCell, ActiveCell).Offset(0, 1).Value
BD = Worksheets(1).Range(ActiveCell, ActiveCell).Offset(0, 2).Value
NRID = Worksheets(1).Range(ActiveCell, ActiveCell).Offset(0, 3).Value
Telno = Worksheets(1).Range(ActiveCell, ActiveCell).Offset(0, 4).Value
position = Worksheets(1).Range(ActiveCell, ActiveCell).Offset(0, 5).Value
joindate = Worksheets(1).Range(ActiveCell, ActiveCell).Offset(0, 6).Value
Salary = Worksheets(1).Range(ActiveCell, ActiveCell).Offset(0, 7).Value
allowance = Worksheets(1).Range(ActiveCell, ActiveCell).Offset(0, 8).Value



Worksheets(2).Range("e6") = name
Worksheets(2).Range("e7") = NRID
Worksheets(2).Range("o7") = Telno
Worksheets(2).Range("ab6") = BD
Worksheets(2).Range("ab7") = position
Worksheets(2).Range("ab8") = joindate
Worksheets(2).Range("z23") = Salary
Worksheets(2).Range("z24") = allowance


Worksheets(2).Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).name = name

Worksheets(1).Activate

ActiveCell.Offset(1, 0).Select
Loop

End Sub

看更多先前的討論...收起先前的討論...
您好
worksheets(2).copy
但您目前只有一個 sheet , 並沒有 sheet 2
AnakinTai iT邦新手 5 級 ‧ 2021-04-16 15:08:37 檢舉
圖2是我新建的工作薄,而且圖2的複製是手動,不是用VBA運行.
Do until 條件,這行程式被擋住了。
如果可以貼純文字程式碼,
除錯會比較方便。
AnakinTai iT邦新手 5 級 ‧ 2021-04-17 10:28:46 檢舉
@來杯拿鐵 已經貼了,我有成功過一次,第二次又不行了.
AnakinTai iT邦新手 5 級 ‧ 2021-04-17 10:30:43 檢舉
這個WORKBOOK內的工作表就算不用VBA也無法進行複製.好奇怪
錯誤碼1004網上說是工作表太多,記憶體不夠用。
Sheets("A表").Range("V4:AZ4").Copy (Sheets("B表").Range("B13:AF13"))
手邊沒電腦可能有錯字
更正:工作表太多 => 工作表內資料太多
AnakinTai iT邦新手 5 級 ‧ 2021-04-18 22:51:38 檢舉
@來杯拿鐵但我的v4:az4 copy to b13:af13 我想做到do until ""即下一行是v5:az5 會copy 到 b13:af14
記憶體不夠?但我新開一個工作表,做copy是可以的,但我把vba寫進去就不行了。
AnakinTai iT邦新手 5 級 ‧ 2021-04-18 22:51:38 檢舉
@來杯拿鐵但我的v4:az4 copy to b13:af13 我想做到do until ""即下一行是v5:az5 會copy 到 b13:af14
記憶體不夠?但我新開一個工作表,做copy是可以的,但我把vba寫進去就不行了。
Sub test()
'假設情境如下
'"員工名單"是總表,每月列印套版"個人薪資表"列印出個人薪資
'

Dim name As String
Dim Salary As Double
Dim NRID As Double
Dim manyCols As Range

'除錯
Dim msg As String

Worksheets("員工名單").Activate '第一筆資料起始點
Range("B4").Activate

Do Until ActiveCell = ""
'總表
With Sheets("員工名單")
name = ActiveCell.Value
Salary = ActiveCell.Offset(0, 1).Value
BD = ActiveCell.Offset(0, 2).Value
Set manyCols = .Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 2)) '複製多欄
'...其他欄位
End With

'套版
With Sheets("個人薪資")
.Range("E6") = name
.Range("E7") = Salary
.Range("O7") = BD
manyCols.Copy (.Range("A1")) '貼上多欄
'...其他欄位
.Copy after:=Sheets(Sheets.Count) '新增一張個人薪資表
End With

Sheets(Sheets.Count).name = name

'選取下一筆
Sheets("員工名單").Select
ActiveCell.Offset(1, 0).Select '選取下一筆資料
msg = msg & name & ", "
Loop

MsgBox ("已建立 " & msg & " 個人薪資表")

End Sub

尚未有邦友回答

立即登入回答