Excel：特定の行に値をコピーするVBA

Question

現在、あるシート（BACKEND）から特定のセルの値をコピーし、次の空白行の別のシート（EXPORT_DATA）の特定の列にペーストします。

Sub copy_values(Optional Source As String = "A1", Optional Source2 As String = "A1") 

    Dim R As Range 
    Dim col As Long 
    col = Range(Source).Column 

    Set R = Worksheets("EXPORT_DATA").Cells(Rows.Count, col).End(xlUp) 
    If Len(R.Value) > 0 Then Set R = R.Offset(1) 
    R.Value = Worksheets("BACKEND").Range(Source2).Value 

End Sub 

それはうまく動作しますが、私はそれはそれはどこのセルに一列にデータを貼り付ける場所に機能するには、列の次の空白のセルにデータを貼り付ける場所で関数を置き換えたいです指定された値を保持します。

c1 c2 c3 
a  b  4 
c  d  6 

ステップ2（マクロの後に実行）：

例えば、古い機能は、以下の

ステップ1だろう

c1 c2 c3 
a  b  4 
c  d  6 
c  d  5 

をしかし、私はその新しい機能を必要とします

ステップ2（C1値を指定し、マクロを実行）：

c1 c2 c3 
a  b  4 
c  d  5 

Answer 1

これがどのように役立つかをご覧ください。あなたがどのように呼びかけているかわからないが、それは合理的な出発点でなければならない。私は本当に簡単なテスト

Sub copy_values_SINGLE(cValue As Variant, Optional Source As String = "A1", Optional Source2 As String = "A1") 
' Not sure of what value type c in your question would be but expects a single value to test against the column provided as Source 
' Requires cValue to be provided 

    Dim R As Range 
    Dim col As Long 
    Dim destRow As Integer 

    col = Range(Source).Column 

    On Error Resume Next 
    destRow = 0 
    destRow = Worksheets("EXPORT_DATA").Columns(col).Find(cValue, SearchDirection:=xlPrevious).Row 
    If destRow = 0 Then destRow = Worksheets("EXPORT_DATA").Cells(Rows.Count, col).End(xlUp).Row + 1 ' if cValue isnt found reverts to the last row as per previous code 
    On Error GoTo 0 

    Set R = Worksheets("EXPORT_DATA").Cells(destRow, col) 
    R.Value = Worksheets("BACKEND").Range(Source2).Value 

End Sub 

Answer 2

これは、特定のまだ

Sub copy_values(Optional Source As String = "A1", Optional Source2 As String = "A1") 

    Dim R As Variant 
    Dim col As Long 
    col = Range(Source).Column 

    Dim mrn As String 
    Dim FoundCell As Excel.Range 
    Dim myVal As String 

    R = Worksheets("BACKEND").Range(Source2).Text 
    myVal = Worksheets("BACKEND").Range(Source2).Text 
    mrn = Worksheets("BACKEND").Range("A5").Value 
    Set FoundCell = Worksheets("EXPORT_DATA").Range("A:A").Find(what:=mrn, lookat:=xlWhole, searchdirection:=xlPrevious) 

    If Not FoundCell Is Nothing Then 
'  MsgBox (R & " " & col & " " & FoundCell.Row) 
     Worksheets("EXPORT_DATA").Range("Q" & FoundCell.Row).Value = R 
     Else 
     MsgBox "error" 
    End If 

End Sub 

Answer 3

ない100％に働くかもしれないが、私は、これはあなたが後にあるかだと思うそれを与えました。ファイルは、EXPORT_DATAファイルの列Aのすべての値をループし、BACKENDワークシートのセルA1の値と比較します。それは価値を見つけた場合、それは価値を見つけることができない場合、それは最後にそれを追加し、列Bの値を置き換えます。

Sub copy_values_SINGLE() 

Dim R As Range 
Dim rowCount As Long 
Dim varValue As Variant 


rowCount = Application.WorksheetFunction.CountA(Worksheets("EXPORT_DATA").Range("A:A")) 

For s = 1 To rowCount 
    If Worksheets("EXPORT_DATA").Range("A" & s).Value = Worksheets("BACKEND").Range("A1").Value Then 
    Worksheets("EXPORT_DATA").Range("A" & s & ":B" & s).Value = Worksheets("BACKEND").Range("A1:B1").Value 
    Exit For 
    Else 
     If s = rowCount Then 
     Set R = Worksheets("EXPORT_DATA").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) 
     R.Value = Worksheets("BACKEND").Range("A1:B1").Value 
     End If 
    End If 
Next s 

End Sub 

が、これはあなたのために働くなら、私に教えてください。