Excel Forum

Code: Select all

Sub PD()
Sheets("PD").Activate
Application.Goto Reference:="OFFSET(R2C1,0,4,1,1)"
   Selection.Copy
Sheets("Data").Select
    'Sheets("Sheet1").Select
   'Sheets("PD").Activate
     Application.Goto Reference:= _
        "OFFSET('[Test.xlsm]Data'!R2C1,MATCH(R2C1,INDEX('[Test.xlsm]Data'!R2C1:R50000C1,0),0),4)"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Code: Select all

Sub PD()

Dim firstID As String

    Sheets("PD").Activate
    Application.Goto Reference:="OFFSET(R2C1,,,,6)"
       Selection.Copy
   
    Sheets("Data").Select
    
    firstID = Range("A2").Value
    If firstID = """" Then Application.Goto Reference:="R2C1" 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Else
    
    Application.Goto Reference:="R1C1"
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


End Sub

Code: Select all

Sub PD()


    Sheets("PD").Activate
    Application.Goto Reference:="OFFSET(R2C1,0,4,1,1)"
       Selection.Copy
   
    Sheets("Data").Select
    Application.Goto Reference:= _
        "INDEX(Data!R2C1:R11C6,LARGE(IF(Data!R2C1:R11C1=PD!R2C1,ROW(Data!R2C1:R11C1)-ROW(Data!R1C1)),1),5)"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


End Sub

Code: Select all

Sub PD()
ThisWorkbook.Activate
    Sheets("PD").Activate
    Application.Goto Reference:="OFFSET(R2C1,0,4,1,1)"
       Selection.Copy 
    Workbooks("Data.xlsx").Activate 
    Sheets("Data").Select
    Application.Goto Reference:= _
        "INDEX('[Data.xlsx]Data'!R2C1:R5000C9,LARGE(IF('[Data.xlsx]Data'!R2C1:R5000C1=PD!R2C1,ROW('[Data.xlsx]Data'!R2C1:R5000C1)-ROW('[Data.xlsx]Data'!R1C1)),1),5)"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


End Sub

Code: Select all

Dim i As Long
Dim r As Range, rTgAll As Range
Set r = ThisWorkbook.Worksheets("PD").Range("a2")
With Workbooks("Data.xlsx").Worksheets("Data")
    Set rTgAll = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    For i = rTgAll.Count To 1 Step -1
        If rTgAll(i).Value = r.Value Then
            rTgAll(i).Offset(0, 4).Value = r.Offset(0, 4).Value
            Exit For
        End If
    Next i
End With