使用Excel VBA按特定规则将下拉列表数据转至其他工作表

需要将Sheet1中B4:M29区域内下拉列表的用户选择值，按以下规则转移到Sheet5的B6:G56区域：

• Sheet1中B列的每个值，对应作为Sheet5中A列的标题行内容
• Sheet1中对应B列单元格右侧的连续值（C到M列），按换行方式依次填入Sheet5对应A列标题行的B到G列中

源数据示例：

目标格式示例：

原代码仅实现了区域值的反向复制，未满足数据转移规则，以下是符合需求的完整代码：

Sub Group6_Click()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim sourceRange As Range, targetCell As Range
    Dim i As Integer, j As Integer, rowOffset As Integer
    
    ' 定义源工作表和目标工作表
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    Set wsTarget = ThisWorkbook.Sheets("Sheet5")
    Set sourceRange = wsSource.Range("B4:M29")
    
    ' 清空目标区域原有数据
    wsTarget.Range("A6:G56").ClearContents
    
    rowOffset = 0 ' 目标区域的行偏移量
    
    ' 遍历源区域的每一行（对应Sheet1的B4到B29）
    For i = 1 To sourceRange.Rows.Count
        ' 将Sheet1的B列值写入Sheet5的A列标题行
        wsTarget.Range("A6").Offset(rowOffset, 0).Value = sourceRange.Cells(i, 1).Value
        
        ' 遍历当前行的C到M列（共11个单元格），按每6个一组填入Sheet5的B到G列，换行填充
        For j = 2 To sourceRange.Columns.Count
            ' 计算目标单元格的位置：每6个值换一行
            Set targetCell = wsTarget.Range("B6").Offset(rowOffset + (j - 2) \ 6, (j - 2) Mod 6)
            targetCell.Value = sourceRange.Cells(i, j).Value
        Next j
        
        ' 更新行偏移量：当前行的11个值需要占2行（6+5），所以偏移量加2
        rowOffset = rowOffset + 2
    Next i
    
    ' PDF导出逻辑
    Dim sFile As String, vFile As Variant
    sFile = Replace(Replace(ThisWorkbook.Name, "KV_Envanter", ""), ".", "_") _
            & "_" & Format(Now(), "yyyymmdd_hhmm") & ".pdf"
    sFile = ThisWorkbook.Path & "\" & sFile
    
    vFile = Application.GetSaveAsFilename( _
        InitialFileName:=sFile, _
        FileFilter:="PDF 文件 (*.pdf), *.pdf", _
        Title:="选择保存路径和文件名")
    
    If vFile <> "False" Then
        ' 设置Sheet5页面布局
        With wsTarget.PageSetup
            .Orientation = xlLandscape
            .LeftMargin = Application.InchesToPoints(0)
            .RightMargin = Application.InchesToPoints(0)
            .TopMargin = Application.InchesToPoints(0)
            .BottomMargin = Application.InchesToPoints(0)
            .FitToPagesWide = 1
        End With
        
        ' 导出PDF
        wsTarget.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=vFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
            
        MsgBox "报告已生成。"
    End If
End Sub

1. 数据转移逻辑
   • 遍历Sheet1的B4至B29每行，将B列值写入Sheet5的A列作为对应组的标题
   • 对每行右侧C-M列的11个值，按每6个一组填充到Sheet5的B-G列，满6个值自动换行到下一行
   • 每个源行对应目标区域2行，处理完一行后偏移量加2，确保标题和对应值位置正确
2. PDF导出优化
   • 直接操作目标工作表，避免依赖ActiveSheet引发的错误
   • 先设置页面布局再导出，保证PDF格式符合要求
   • 提示文本改为中文，更符合使用习惯

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