复制＆amp;粘贴

Question

目标：我正在尝试按照查找（即区域）复制，查找和粘贴数据。

问题：当我定义粘贴数据的位置时，我得到了所需的输出。但这不是宏所要做的。它假设查找该区域名称，然后将数据粘贴到相应的标题下，依此类推。

这是我到目前为止所写的内容：

Sub DataPasting()

ApplicationUpdating = False

Sheets("Sheet1").Range("I2:J2").Copy        'copy and pasting the data set from Sheet1
Sheets("Stories & Topics").Select

    Dim RegionColumn As Long
    Dim erow As String


    RegionColumn = Application.WorksheetFunction.Match(Sheets("Raw").Range("H1"), Sheets("Stories & Topics").Range("A1:Z1"), False)

    erow = ThisWorkbook.Worksheets("Stories & Topics").Cells(Rows.Count, "B").End(xlUp).Row

     ThisWorkbook.Worksheets("Stories & Topics").Paste (ThisWorkbook.Worksheets("Stories & Topics").Range("B" & erow + 1))

        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


ApplicationUpdating = True


End Sub

注意：

Sheet1 =要从中复制数据的工作表 故事＆amp; Topics =必须粘贴数据的目标表单

我也尝试了Vlookup和Match，但没有用。

谢谢！

Answer 1

很难从你的代码中准确地告诉你正在做什么，但这样的事情应该有效：

Sub DataPasting()

    Dim RegionColumn 'variant
    Dim erow As Long
    Dim shtRaw As Worksheet, shtSaT As Worksheet, shtOne As Worksheet

    Set shtRaw = ThisWorkbook.Sheets("Raw")
    Set shtSaT = ThisWorkbook.Sheets("Stories & Topics")
    Set shtOne = ThisWorkbook.Sheets("Sheet1")

    ApplicationUpdating = False

    RegionColumn = Application.Match(shtRaw.Range("H1").Value, _
                                     shtSaT.Range("A1:Z1"), 0)

    If Not IsError(RegionColumn) Then

        erow = shtSaT.Cells(Rows.Count, "B").End(xlUp).Row

        shtSaT.Cells(erow, RegionColumn).Resize(1, 2).Value = shtOne.Range("I2:J2").Value

    End If

    ApplicationUpdating = True


End Sub