用于将Excel电子表格合并到摘要表单的可视基本代码 [英] Visual basic code to merge excel spreadsheets into a summary sheet
本文介绍了用于将Excel电子表格合并到摘要表单的可视基本代码的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我正在将一些电子表格合并到一个摘要表中，但我不希望复制数据（从多个工作表）开始直到行/列D9，我不希望它在摘要表上开始粘贴，直到D9 。这是我目前的代码...如何添加其他指令？
Sub CopyDataWithoutHeaders（）
Dim sh As 工作表
Dim DestSh 作为工作表
Dim 最后作为 长
Dim shLast 作为 长
Dim CopyRng 作为范围
Dim StartRow As 长
使用应用
.ScreenUpdating = 错误
。 EnableEvents = False
结束 使用
' 删除摘要表（如果存在）。
Application.DisplayAlerts = False
On 错误 恢复 下一步
ActiveWorkbook.Worksheets（ 全面）。删除
开启 错误 GoTo 0
Application.DisplayAlerts = True
' 添加新摘要工作表。
设置 DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = Comprehensive
' 填写起始行。
StartRow = 2
' 遍历所有工作表并将数据复制到
摘要工作表。
对于 每个 sh 在 ActiveWorkbook.Worksheets
如果 sh.Name<> DestSh.Name 然后
' 查找包含摘要数据的最后一行
' 和源工作表。
Last = LastRow（DestSh）
shLast = LastRow（sh）
' 如果源工作表不为空，如果最后
' row> = StartRow，复制范围。
如果 shLast> 0 shLast> = StartRow 然后
' 设置要复制的范围
设置 CopyRng = sh.Range（sh.Rows（StartRow），sh.Rows（shLast））
' 测试以查看摘要中是否有足够的行
' 工作表来复制所有数据。
如果 Last + CopyRng.Rows.Count> DestSh.Rows.Count 然后
MsgBox &中没有足够的行。 _
用于放置数据的摘要工作表。
GoTo ExitTheSub
结束 如果
' 此语句复制值和格式。
CopyRng.Copy
使用 DestSh.Cells（最后+ 1 ， A）
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = 错误
结束
< span class =code-key单词>结束 如果
结束 如果
下一步
ExitTheSub：
申请。 转到 DestSh.Cells（ 1 ）
' 在摘要表中自动调整列宽。
DestSh.Columns.AutoFit
使用应用程序
.ScreenUpdating = True
.EnableEvents = True
结束 使用
结束 Sub
< b>我尝试了什么：
还没有。只使用已经描述的VB代码...
解决方案
这是一个代码版本，它将数据从D9复制到所用数据的末尾并粘贴结果进入[综合]表格，从单元格D9开始，而不是A2。它将D9中存在的数据复制到最后一列，而不是尝试复制所用行的所有列，否则将没有足够的列用于复制。
我将离开它可以让你发现差异
选项 明确
Sub CopyDataWithoutHeaders（）
Dim sh < span class =code-keyword> As 工作表
Dim DestSh As 工作表
Dim 最后作为 长
Dim shLast As 长
Dim CopyRng As 范围
< span class =code-keyword> Dim StartRow As Long
使用应用程序
.ScreenUpdating = False
.EnableEvents = False
结束 使用
' 删除摘要表（如果存在）。
Application.DisplayAlerts = 错误
开启 错误 < span class =code-keyword> Resume Next
ActiveWorkbook.Worksheets（ 全面）。删除
开启 错误 GoTo 0
Application.DisplayAlerts = True
' 添加新的摘要工作表。
设置 DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = Comprehensive
' 填写起始行。
StartRow = 9
' 遍历所有工作表并将数据复制到
摘要工作表。
对于 每个 sh 在 ActiveWorkbook.Worksheets中
如果 sh.Name<> DestSh.Name 然后
' 查找包含摘要数据的最后一行
' 和源工作表。
Last = LastRow（DestSh）
shLast = LastRow（sh）
如果 Last< 9 然后最后= 8 我们稍后再添加+1
' 查找源工作表上使用的最后一个单元格，由Andy Pope提供，OzMVP
Dim lastCell 作为 字符串
lastCell =替换（Cells（ 1 ，sh.UsedRange.Columns.Count）.Address（ False ， False ）， 1， CStr （shLast））
' 如果源工作表不为空且如果最后一个
' row> = StartRow，复制范围。
如果 shLast> 0 shLast> = StartRow 然后
' 设置要复制的范围
设置 CopyRng = sh.Range（ D& < span class =code-keyword> CStr （StartRow）& ： & lastCell）
' 测试以查看摘要中是否有足够的行
' 复制所有数据的工作表。
如果 Last + CopyRng.Rows.Count> DestSh.Rows.Count 然后
MsgBox &中没有足够的行。 _
用于放置数据的摘要工作表。
GoTo ExitTheSub
结束 如果
' 此语句复制值和格式。
CopyRng.Copy
使用 DestSh.Cells（最后+ 1 ， D）
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = 错误
结束
< span class =code-k eyword>结束 如果
结束 如果
下一步
ExitTheSub：
申请。 转到 DestSh.Cells（ 1 ）
' 在摘要表中自动调整列宽。
DestSh.Columns.AutoFit
使用应用程序
.ScreenUpdating = True
.EnableEvents = True
结束 使用
结束 Sub
私有 函数 LastRow（ws 作为工作表）作为 长
LastRow = ws.UsedRange.Rows.Count
结束 功能
I am merging some spreadsheets into one summary sheet, but I do not want the data copied (from the multiple sheets) to start until row/column D9 and I do not want it to start the paste on the summary sheet until D9. Here is my current code... How do I add the other directives?
Sub CopyDataWithoutHeaders()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Delete the summary sheet if it exists.
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Comprehensive").Delete
On Error GoTo 0
Application.DisplayAlerts = True
' Add a new summary worksheet.
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Comprehensive"
' Fill in the start row.
StartRow = 2
' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
' Find the last row with data on the summary
' and source worksheets.
Last = LastRow(DestSh)
shLast = LastRow(sh)
' If source worksheet is not empty and if the last
' row >= StartRow, copy the range.
If shLast > 0 And shLast >= StartRow Then
'Set the range that you want to copy
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
' Test to see whether there are enough rows in the summary
' worksheet to copy all the data.
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the " & _
"summary worksheet to place the data."
GoTo ExitTheSub
End If
' This statement copies values and formats.
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
End If
End If
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
' AutoFit the column width in the summary sheet.
DestSh.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
What I have tried:
nothing yet. just using the VB code already described...
解决方案
Here is a version of your code that copies data from D9 to the end of the data used and pastes the results into the [Comprehensive] sheet starting at cell D9 instead of A2. It copies the data present from D9 to the last column rather than attempting to copy all of the columns for the rows used otherwise there would be not enough columns for the copy to take place.
I'll leave it to you to spot the differences
Option Explicit Sub CopyDataWithoutHeaders() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim shLast As Long Dim CopyRng As Range Dim StartRow As Long With Application .ScreenUpdating = False .EnableEvents = False End With ' Delete the summary sheet if it exists. Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("Comprehensive").Delete On Error GoTo 0 Application.DisplayAlerts = True ' Add a new summary worksheet. Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "Comprehensive" ' Fill in the start row. StartRow = 9 ' Loop through all worksheets and copy the data to the ' summary worksheet. For Each sh In ActiveWorkbook.Worksheets If sh.Name <> DestSh.Name Then ' Find the last row with data on the summary ' and source worksheets. Last = LastRow(DestSh) shLast = LastRow(sh) If Last < 9 Then Last = 8 'As we add +1 later 'Find the last cell used on the source worksheet courtesy of Andy Pope, OzMVP Dim lastCell As String lastCell = Replace(Cells(1, sh.UsedRange.Columns.Count).Address(False, False), "1", CStr(shLast)) ' If source worksheet is not empty and if the last ' row >= StartRow, copy the range. If shLast > 0 And shLast >= StartRow Then 'Set the range that you want to copy Set CopyRng = sh.Range("D" & CStr(StartRow) & ":" & lastCell) ' Test to see whether there are enough rows in the summary ' worksheet to copy all the data. If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then MsgBox "There are not enough rows in the " & _ "summary worksheet to place the data." GoTo ExitTheSub End If ' This statement copies values and formats. CopyRng.Copy With DestSh.Cells(Last + 1, "D") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With End If End If Next ExitTheSub: Application.Goto DestSh.Cells(1) ' AutoFit the column width in the summary sheet. DestSh.Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With End Sub Private Function LastRow(ws As Worksheet) As Long LastRow = ws.UsedRange.Rows.Count End Function
这篇关于用于将Excel电子表格合并到摘要表单的可视基本代码的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
