从数据条目（如工作表）复制值并将它们粘贴到单个工作表中，根据一个单元格中的某个值连续粘贴

Posted 2023-03-27

【中文标题】从数据条目（如工作表）复制值并将它们粘贴到单个工作表中，根据一个单元格中的某个值连续粘贴

【英文标题】：Copy values from a data entry like sheet and paste them into individual sheets, in a row based on a certain value in one cell

【发布时间】：2021-12-01 19:46:02

【问题描述】：

我正在编写一个宏来从“DataEntry”工作表中获取值并将它们粘贴到工作表中，该工作表在各个工作表上的 F1 中的值与主工作表上的 A 列中的值相同

DataEntry 工作表是工作簿中可见的第 2 工作表，并且宏必须从可见工作表 3 开始粘贴值，而不是在我的第一个名为“摘要”的工作表中

更新：我设法让它只在可见的工作表上工作

我还希望它根据 DataEntry 上 F2 中的值（参见附图编号 1）和各个工作表上 B 列中的相应值（在日期标题见附图 2)

到目前为止我遇到的问题：

我还没有将副本添加到我的代码中的某个行部分，因为我正在努力弄清楚

我最初将所有 F2 值复制到主工作表，并尝试将 B*:D* 中的所有值粘贴到各自的工作表中 只需遍历整个列表

更新：我已经设法通过使用 Cells.Address 作为我的范围来复制它，并让它在各个工作表上运行

Screenshot of “DataEntry” sheet

Screenshot of the cells on typical individual sheet that the data must go to

这是我目前的代码

Sub CopyDieseltoSheets()

Dim wsInput As Worksheet, wsOutput As Worksheet
Set wsInput = ThisWorkbook.Sheets("DataEntry")
Dim nextRow As Integer
nextRow = 3
Dim rng As Range
Dim shCount As Integer
shCount = 4
Dim TabCount As Long
TabCount = Sheets("COMPRESSOR AN01 - ROADSPAN").Index

Do

    If ThisWorkbook.Sheets(shCount).Visible <> xlSheetHidden Then
        
        With wsInput
              Set rng = .Range(Cells(nextRow, 2).Address(), Cells(nextRow, 4).Address())
              rng.Copy
                
              Set wsOutput = ThisWorkbook.Sheets(shCount)
             
                With wsOutput
                    .Range("C16:E16").PasteSpecial xlPasteValues, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                End With

`I need to change the range in the output based on the value in F2 on the "DataEntry" sheet but not sure what is the best way to go about it
              
        End With
        
        nextRow = nextRow + 1
        
    Else
    
    End If
        
        shCount = shCount + 1

Loop Until shCount = TabCount + 1
  
Exit Sub

End Sub

任何帮助将不胜感激

【问题讨论】：

您的If 声明一直引用wsInput.Name，这将是DataEntry；应该是wsOutput.name？

代替粘贴，也许您可​​以尝试将 rng 的值分配给 wsOutput 中的范围？将是一个“更便宜”的操作，步骤更少。

@ProfessorPantsless If wsOutput.Name <> wsInput.Name _ And wsOutput.Name <> "Summary" And wsOutput.Name <> "Start" _ And wsOutput.Visible = True Then 喜欢这样吗？

从您的问题中不清楚确定输出范围的逻辑是什么。你能提供一些具体的例子吗？此外，您应该始终限定您的Sheets 参考，因为不合格将使用活动工作簿，即ThisWorkbook.Sheets...。不确定这是否是您的问题，但工作表的 Visible 属性可以采用 3 个值：xlSheetVisible、xlSheetHidden 和 xlSheetVeryHidden（不是 xlHidden）。

我还不能投票，因为到目前为止我只有 1 个声望点@ProfessorPantsless。当我达到 15 个声望时会这样做

【参考方案1】：

您可以使用Range 对象的Find() 方法来实现您想要的。您可以使用Offset() 和Resize 从那里导航到您想要的单元格。正如@HarvardKleven 提到的，您可以使用rng1 = rng2 将值从rng2 复制和粘贴到rng1，这往往比在VBA 中使用copy 和paste 方法更有效（即“更便宜”）。

下面的代码可以替换您当前的Do...Loop，并且应该可以满足您的需求。请注意，我添加了一个附加变量 outputRng 作为 Range 对象。

Do

    If ThisWorkbook.Sheets(shCount).Visible <> xlSheetHidden Then
        
        Set rng = wsInput.Range(Cells(nextRow, 2).Address(), Cells(nextRow, 4).Address())
                        
        Set wsOutput = ThisWorkbook.Sheets(shCount)
             
        ' find the value you are looking for in column B
        ' get the cell next to it (offset)
        ' resize this range to have the same number of columns as rng (resize)
        Set outputRng = wsOutput.Range("B:B").Find(rng.Value).Offset(0, 1).Resize(ColumnSize:=rng.Columns.Count)
        
        outputRng = rng 'will set the values from outputRng to the values from rng

        nextRow = nextRow + 1
    
    End If
        
        shCount = shCount + 1

Loop Until shCount = TabCount + 1