时间戳

首页 > 解决方案 > VBA代码将集合值从主表复制到多张表的最后一行

excel - VBA代码将集合值从主表复制到多张表的最后一行

问题描述

我对使用 VBA 还很陌生，但我会尽量让我的问题清晰简洁。

我有一组常规数据（85 行），我将其复制到 Excel 上的“主工作表”中。

我想编写一个代码，将主工作表的每一行复制到单独工作表（85 张）上的下一个空行上。

我知道如何在任何给定的工作表上查找和设置最后一行，但我无法锻炼如何粘贴到目标工作表的最后一行，而不必分别“设置”/定义每张工作表的最后一行。

为了更好地解释：

我想从“主工作表”上的 A2:A4 中获取值并将它们粘贴到工作表“Aa”的下一个空行然后从“主工作表”上的 B2:B4 中复制值并将它们粘贴到下一个空行中工作表“Bb”的行然后来自“主工作表”上C2：C4的值并粘贴到工作表“Cc”的下一个空行......（依此类推）

您可以提供的任何帮助将不胜感激。

标签： excelvba

解决方案

我问了一些问题，但没有回复...试试看，请下一个代码。它被设计为在同一个工作簿 (ThisWorkbook) 上工作，但评论使用不同的工作簿。该代码使用通用范围，包括最后 K 列，但可以通过简单地将 K 替换为最后一列字母来扩展它。它还假设所有列都具有相同的行数。

该代码使用数组并在内存中工作，应该足够快。请对其进行测试并给我们一些反馈：

Sub pasteRangeFromMasterSheet()
 Dim sh As Worksheet, ws As Worksheet, wb As Workbook, lastRow As Long, lastR As Long, rngArr As Variant
 Set sh = ActiveSheet 'you have to use here your 'master sheet'
 lastRow = sh.Range("A" & Rows.count).End(xlUp).Row 'master sheet last row
 rngArr = sh.Range("A2:K" & lastRow).value 'you have to use your last column letter instead of 'K'
 Set wb = ThisWorkbook 'in case of a different workbook, you must set it here
 For Each ws In wb.Worksheets
    If ws.Name <> sh.Name Then 'in case of copying in sheets of the same workbook
        lastR = ws.Range("A" & Rows.count).End(xlUp).Row + 1 'last (empty) row
        'Drop the values in the last empty row:
        ws.Range("A" & lastR).Resize(UBound(rngArr, 1), UBound(rngArr, 2)).value = rngArr
    End If
 Next
End Sub

如果是空工作表（ws），该代码也可以适应复制列标题。

推荐阅读