Excel 复制到另一工作表中动态创建的行

我想将粘贴值从一个工作表的四列复制到另一个工作表的四列，但动态添加行，因为每次的项目数都不相同

Private子命令按钮1\u单击（）
调暗最后一行的长度，调暗最后一行的长度
带工作表（“jun”）
erow=21
lastrow=.Cells（Rows.Count，1）.End（xlUp）.Row
对于i=8到最后一行
如果.Cells（i，16）.Value为“”，则
.细胞（i，16）。复制
工作表（“测试”）.单元格（erow，1）.粘贴特殊粘贴：=XLPasteValues和NumberFormats
.单元格（i，3）.复制
工作表（“测试”）.单元格（erow，2）.粘贴特殊粘贴：=XLPasteValues和NumberFormats
.细胞（i，2）.复制
工作表（“测试”）.单元格（erow，4）.粘贴特殊粘贴：=XLPasteValues和NumberFormats
.细胞（i，6）。复制
工作表（“测试”）.单元格（erow，5）.粘贴特殊粘贴：=XLPasteValues和NumberFormats
erow=erow+1
如果结束
接下来我
以
端接头

最简单的解决方案是制作大量空白行，然后粘贴，但必须有一个更优雅的解决方案，因为如果我只有几个项目要粘贴，这是不实际的

---

我想留下两个空格，即图中的第22行和第23行，以及之后的最后一行，我希望始终保留第24行。

这应该让您开始

阅读评论并根据需要进行调整

注意：代码缺少错误控制

Public Sub CopyData()
    
    ' Define the object variables
    Dim templateWorksheet As Worksheet
    Dim sourceWorksheet As Worksheet
    Dim newWorksheet As Worksheet
    
    ' Define other variables
    Dim newSheetName As String
    
    
    
    Dim lastSourceRow As Long
    Dim startSourceRow As Long
    Dim lastTargetRow As Long
    Dim sourceRowCounter As Long
    Dim columnCounter As Long
    
    Dim columnsToCopy As Variant
    Dim columnsDestination As Variant
    
    ' Adjust the worksheets names
    Set templateWorksheet = ThisWorkbook.Worksheets("Template")
    Set sourceWorksheet = ThisWorkbook.Worksheets("Source")
    
    ' Ask for the new sheet name
    newSheetName = InputBox("Enter new sheet name")
    
    ' Add the new sheet
    Set newWorksheet = ThisWorkbook.Worksheets.Add
    
    ' Rename it
    newWorksheet.Name = newSheetName
    
    ' Define the number of columns to copy from one sheet to the other
    columnsToCopy = Array(1, 5, 21, 27, 29, 231)
    columnsDestination = Array(1, 2, 3, 4, 5, 6) ' -> This must have the same items' quantity as columnsToCopy
        
    ' Adjust the initial row
    startSourceRow = 8
    
    ' Find the number of the last row in source sheet (notice that this search in column A = 1)
    lastSourceRow = sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 1).End(xlUp).Row

    For sourceRowCounter = startSourceRow To lastSourceRow
                
        ' Get last row on target sheet (notice that this search in column A = 1)
        lastTargetRow = newWorksheet.Cells(newWorksheet.Rows.Count, 1).End(xlUp).Row
        
        For columnCounter = 0 To UBound(columnsToCopy)
            
            ' You don't need to use copy and paste if values is all that you're passing (otherwise use the copy destination method)
            newWorksheet.Cells(lastTargetRow, columnsDestination(columnCounter)).Offset(1, 0).Value = sourceWorksheet.Cells(sourceRowCounter, columnsToCopy(columnCounter)).Value
        
        Next columnCounter
                    
    Next sourceRowCounter
    
    ' If this is necessary...
    sourceWorksheet.Activate

End Sub

---

让我知道这是否有帮助

新项目是否替换旧项目？我看到这些表是几个月，你把它们累积在一张测试表中。这是正确的吗？是的，你明白了！理想情况下，我希望每个月为相同的模板创建一个新的测试表，这样他们就不应该替换旧的测试表。而是创建此模板的新工作表，并按照我在问题中描述的方式插入行。然而，我还没有深入到如何做到这一点：）。你对我最初的问题有什么建议吗，先生？