因为需要将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