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

Question

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

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

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

我还希望它根据 DataEntry 上 F2 中的值（参见附图编号 1 ）和各个工作表上 B 列中的相应值（在日期标题下参见附图编号 2 ）将其粘贴到某一行中

目前我遇到的问题：

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

2. 我最初将所有 F2 值复制到主工作表，并尝试通过运行整个列表将 B*:D* 中的所有值粘贴到各自的工作表

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

“DataEntry”表的屏幕截图

数据必须转到的典型单个工作表上的单元格的屏幕截图

这是我到目前为止的代码

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

任何帮助将不胜感激

Answer 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