将单元格+关联列复制到另一个工作表

Question

我有两张纸，数据和空白。

我想将单元格从数据复制到空白。我希望生成的所有数据都从 B1 开始。需要空白栏 A 来获取自行生成的数据。

1. 我想使用命令操作（例如 Ctrl + Shift + W）来提示 GUI，要求我输入要从数据复制的单元格。

2. 因此，在 B1 中，我将获取在 GUI 中输入的单元格的值。

3. 我想在空白表上生成两个单元格。我想添加两个可以从 X 行（我的 GUI 输入的单元格所在的行）、X 和 X 列（只是要概括的变量）中提取的单元格。

示例：
我输入 Ctrl + Shift + W。系统提示我输入一个单元格。 C 鉴于它不为空，我将在单元格 G4 中键入。 G4 的 Data 值将上传到 Blank 的 B1 中。
我还想要 E 列和 D 列中的数据（这些数据永远不会改变，因此无需每次都输入）。在 C1 中，E4 的值，在 D1 中，V4 的值。

我想在 A 列中处于活动状态，因此当我在 A1 中输入内容时，我可以运行命令并生成 A1 到 D1 的数据。当我完成 A2 的输入后，我想在 B2 中运行该命令，以便为 B2、B3 和 B43 生成值。

Sub CopyDataToTest()
    Dim sourceCell As Range
    Dim targetRange As Range
    Dim dataSheet As Worksheet
    Dim blankSheet As Worksheet
    
    ' Set references to Data and Blank sheets
    Set dataSheet = ThisWorkbook.Sheets("Data")
    Set blankSheet = ThisWorkbook.Sheets("Blank")
    
    ' Prompt user to select a cell in Data sheet
    On Error Resume Next
    Set sourceCell = Application.InputBox("Select a cell in Data to copy", Type:=8)
    On Error GoTo 0
    
    ' Check if user selected a cell
    If Not sourceCell Is Nothing Then
        ' Copy value to B1 in Test sheet
        blankSheet.Range("B1").Value = sourceCell.Value
        
        ' Copy values from columns H and D in Data sheet to C1 and D1 in Blank sheet
        blankSheet.Range("C1").Value = dataSheet.Cells(sourceCell.Row, 8).Value ' Column H
        blankSheet.Range("D1").Value = data.Cells(sourceCell.Row, 4).Value ' Column D
        
        ' Activate the column A cell in Blank sheet
        blankSheet.Activate
        blankSheet.Range("A" & sourceCell.Row).Select
    End If
End Sub

我认为我的问题即将结束。也许在“激活”期间。

我获得了 C 和 D 中关联列的正确值。我无法让 B 列生成任何内容。它转到关联的行（假设我在 GUI 中键入 F6，因此在这种情况下它将转到空白中的 F6），但它是空白的。

此外，我只能提交一项。我想添加一个条目，生成 B1 C1 和 D1，然后继续到第 2 行，在单元格中键入，生成 B2 C2 和 D2，依此类推。

Answer 1

• data.Cells(sourceCell.Row, 4).Value

  有错别字。应该是

  dataSheet

  。

• I am entering something in A1 I can run the command

  所以

  blankSheet

  是 GUI 显示时的活动工作表。如果用户仅选择一个单元格（不更改活动工作表）或输入单元格引用（例如，键入 G4）。那么

  sourceCell

  是

  blankSheet

  上的范围对象。它可能是一个空白单元格。然后运行代码后，B1 单元格上就没有任何内容了。

改变：

• 在弹出输入框（GUI）之前激活

  blankSheet

• 添加

  If

  子句以验证

  sourceCell

Option Explicit
Sub CopyDataToTest()
    Dim sourceCell As Range
    Dim targetRange As Range
    Dim dataSheet As Worksheet
    Dim blankSheet As Worksheet
    
    ' Set references to Data and Blank sheets
    Set dataSheet = ThisWorkbook.Sheets("Data")
    Set blankSheet = ThisWorkbook.Sheets("Blank")
    dataSheet.Activate '**
    ' Prompt user to select a cell in Data sheet
    On Error Resume Next
    Set sourceCell = Application.InputBox("Select a cell in Data to copy", Type:=8)
    On Error GoTo 0
    
    ' Check if user selected a cell
    If Not sourceCell Is Nothing Then
        If sourceCell.Parent.Name = "Data" Then '**
            ' Copy value to B1 in Test sheet
            blankSheet.Range("B1").Value = sourceCell.Value
            
            ' Copy values from columns H and D in Data sheet to C1 and D1 in Blank sheet
            blankSheet.Range("C1").Value = dataSheet.Cells(sourceCell.Row, 8).Value ' Column H
            blankSheet.Range("D1").Value = dataSheet.Cells(sourceCell.Row, 4).Value ' Column D
            
            ' Activate the column A cell in Blank sheet
            blankSheet.Activate
            blankSheet.Range("A" & sourceCell.Row).Select
        Else
            MsgBox "Please select a cell on sheet [Data]."
        End If
    End If
End Sub