Excel VBA跨工作簿转置粘贴：实现数据逐行连续放置的需求

以下是修正后的完整代码，解决了数据每隔5行粘贴的问题，实现从第5行开始连续逐行放置转置后的数据：

Sub CopyDataFromWorkbooks()
    Dim wbSource As Workbook
    Dim shTarget As Worksheet
    Dim shSource As Worksheet
    Dim strfile As String
    Dim strPath As String

    Set shTarget = ThisWorkbook.Sheets("CPP Summary")
    strPath = GetPath

    If Not strPath = vbNullString Then
        strfile = Dir$(strPath & "*.xls", vbNormal)
        Do While Not strfile = vbNullString
            Set wbSource = Workbooks.Open(strPath & strfile)
            Set shSource = wbSource.Sheets("Info for CPP")
            
            Call CopyData(shSource, shTarget)
            
            wbSource.Close False
            strfile = Dir$()
        Loop
    End If
End Sub

Sub CopyData(ByRef shSource As Worksheet, shTarget As Worksheet)
    Const VHead As String = "B1:B4"
    'Const VMBom As String = "B8:B25" ' 原代码定义但未使用，若需处理可补充逻辑
    
    Dim glrow As Long
    Dim lastRow As Long
    
    ' 获取目标表A列最后一行有数据的行号
    lastRow = shTarget.Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 判断起始行：如果最后一行小于5，从第5行开始；否则从最后一行的下一行开始
    If lastRow < 5 Then
        glrow = 5
    Else
        glrow = lastRow + 1
    End If

    shSource.Range(VHead).Copy
    With shTarget.Range("A" & glrow)
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
        .PasteSpecial Transpose:=True
    End With
    Application.CutCopyMode = False ' 清除复制状态
End Sub

关键修改说明 #

• 移除固定5行间隔：原代码中Offset(5)是导致数据每隔5行粘贴的核心原因，改为动态判断起始行，确保每次粘贴都衔接上一次的末尾行。
• 强制初始起始行：增加判断逻辑，保证第一次粘贴时从指定的第5行开始，后续操作自动延续到下一行，实现连续逐行放置。
• 清除复制状态：补充Application.CutCopyMode = False，避免复制状态残留影响后续操作。

若需要同时处理VMBom区域的数据，可在CopyData过程中补充对应粘贴逻辑，同样使用动态计算的行号进行放置即可。

内容的提问来源于stack exchange，提问作者Geographos