Excel VBA跨工作表复制单元格问题求助

首先，我先明确下你的需求：把Sheet1中同一单元格的日期+票号，和A10开始的可变长度的item-amount列表，组合成Sheet2里每行都是「日期 票号 item amount」的格式，对吧？下面是具体的实现方案：

步骤1：明确数据结构假设 #

为了代码能准确运行，我先做几个合理假设（如果你的实际结构不同，调整对应单元格即可）：

• Sheet1中日期+票号存放在单元格A1（比如内容是「2024/05/20 TKT00123」）
• Sheet1中从A10开始，A列是item名称（比如A10=itemA，A11=itemB...），B列是对应amount（B10=100，B11=200...），直到某行A列为空时停止

步骤2：完整VBA代码 #

打开Excel按Alt+F11进入VBA编辑器，插入模块后粘贴以下代码：

Sub CopyAndRearrangeData()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim dateTicket As String
    Dim lastRow As Long, targetRow As Long
    Dim i As Long
    
    ' 设置源工作表和目标工作表
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    Set wsTarget = ThisWorkbook.Worksheets("Sheet2")
    
    ' 获取日期+票号内容
    dateTicket = wsSource.Range("A1").Value
    ' 如果A1可能为空，这里可以加判断：If dateTicket = "" Then MsgBox "日期票号单元格为空": Exit Sub
    
    ' 找到Sheet1中A列最后一行有数据的行（从A10开始）
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    ' 如果最后一行小于10，说明没有数据，直接退出
    If lastRow < 10 Then MsgBox "A10开始没有数据": Exit Sub
    
    ' 初始化Sheet2的起始行（从第一行开始，如果你要从其他行改这里）
    targetRow = 1
    
    ' 清空Sheet2原有数据（可选，根据需求决定是否保留）
    wsTarget.Cells.Clear
    
    ' 循环遍历Sheet1中A10到lastRow的行
    For i = 10 To lastRow
        ' 跳过item为空的行
        If wsSource.Range("A" & i).Value <> "" Then
            ' 写入日期票号到Sheet2的A列
            wsTarget.Range("A" & targetRow).Value = dateTicket
            ' 写入item到B列
            wsTarget.Range("B" & targetRow).Value = wsSource.Range("A" & i).Value
            ' 写入amount到C列
            wsTarget.Range("C" & targetRow).Value = wsSource.Range("B" & i).Value
            ' 目标行下移
            targetRow = targetRow + 1
        End If
    Next i
    
    ' 格式化Sheet2的列宽（可选）
    wsTarget.Columns("A:C").AutoFit
    
    MsgBox "数据处理完成！共生成" & targetRow - 1 & "行数据"
End Sub

步骤3：代码调整说明 #

如果你的实际数据结构和假设不同，修改以下部分即可：

• 日期票号的单元格：把wsSource.Range("A1")改成你实际的单元格（比如B2）
• item和amount的列：如果item在B列、amount在C列，就把代码里的A和B对应改成B和C
• Sheet2的起始行：如果不想从第一行开始，把targetRow = 1改成目标行号（比如5）

关键知识点解释 #

• lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row：这是VBA中获取某列最后一行数据的标准写法，能自动适配可变长度的列表
• 循环遍历：通过For i = 10 To lastRow逐个处理每个item，确保不会漏掉数据
• 工作表对象：Set wsSource = ThisWorkbook.Worksheets("Sheet1")确保代码引用的是当前工作簿的工作表，避免出错

参考思路扩展 #

如果你的日期和票号是在同一个单元格里需要拆分（比如要分成单独的日期列和票号列），可以用Split函数处理：

' 假设日期和票号用空格分隔，拆分到两个变量
Dim datePart As String, ticketPart As String
datePart = Split(dateTicket, " ")(0)
ticketPart = Split(dateTicket, " ")(1)
' 然后分别写入Sheet2的A列和B列
wsTarget.Range("A" & targetRow).Value = datePart
wsTarget.Range("B" & targetRow).Value = ticketPart

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