Копирование и вставка

Question

Цель: Я пытаюсь скопировать, найти и вставить данные в соответствии с поиском (то есть Region).

Проблема: я получаю желаемый результат, когда я определяю, где вставить данные. Но это не то, что предполагает макрос. Предположим, что вы ищете имя этого региона, а затем вставьте данные под соответствующим заголовком и так далее.

Вот что я написал до сих пор:

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 

Примечание:

Лист1 = лист, откуда данные должны быть скопированы истории & Темы = Destination лист, где данные должны вставьте

Я также пробовал 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