因為需要將excel的所有分頁合併成一個 在網路上找到一支可以用的程式 在一般的短資料也確實沒有問題 但是當欄位裡面有長資料的時候就會發生錯誤 錯誤訊息顯示為 執行階段錯誤'1004': 應用程式或物件定義上的錯誤 經過幾次測試 發現大約是在內容字元超過950時會發生 使用內建的除錯 顯示錯誤發生在這一行: trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value 但我完全無法看出其中有任何限制欄位內容大小的部份 希望有知道如何修改的強者提點 <(_ _)> 該程式的全部內容如下: 來自http://www.vbaexpress.com/kb/getarticle.php?kb_id=151 (此網頁上的版本應該比較易於閱讀) Sub CopyFromWorksheets() Dim wrk As Workbook 'Workbook object - Always good to work with object variables Dim sht As Worksheet 'Object for handling worksheets in loop Dim trg As Worksheet 'Master Worksheet Dim rng As Range 'Range object Dim colCount As Integer 'Column count in tables in the worksheets Set wrk = ActiveWorkbook 'Working in active workbook For Each sht In wrk.Worksheets If sht.Name = "Master" Then MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _ "Please remove or rename this worksheet since 'Master' would be" & _ "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error" Exit Sub End If Next sht 'We don't want screen updating Application.ScreenUpdating = False 'Add new worksheet as the last worksheet Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)) 'Rename the new worksheet trg.Name = "Master" 'Get column headers from the first worksheet 'Column count first Set sht = wrk.Worksheets(1) colCount = sht.Cells(1, 255).End(xlToLeft).Column 'Now retrieve headers, no copy&paste needed With trg.Cells(1, 1).Resize(1, colCount) .Value = sht.Cells(1, 1).Resize(1, colCount).Value 'Set font as bold .Font.Bold = True End With 'We can start loop For Each sht In wrk.Worksheets 'If worksheet in loop is the last one, stop execution (it is Master worksheet) If sht.Index = wrk.Worksheets.Count Then Exit For End If 'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount)) 'Put data into the Master worksheet trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value Application.DisplayAlerts = False 'cancel alert sht.Delete 'delete sheet Application.DisplayAlerts = True 'recovery alert Next sht 'Fit the columns in Master worksheet trg.Columns.AutoFit 'Screen updating should be activated Application.ScreenUpdating = True End Sub -- --

※ 發信站: 批踢踢實業坊(ptt.cc) ◆ From: 61.231.53.33