1

ある列の値をクリックして他のシートにコピーする方法はありますか。

この図で詳しく説明します。 ここに画像の説明を入力

これが私のコードですが、理由がわからないエラーがいくつかあります：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Sheets("SheetB").Select
    ' Find the last row of data
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    ' Loop through each row
    For x = 1 To FinalRow
        ' Decide if to copy based on column A in sheetB
        ThisValue = Cells(x, 1).Value
        If ThisValue = Target.Value Then
            Cells(x, 1).Resize(1, 33).Copy
            Sheets("SheetC").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("SheetB").Select
         End If
    Next x

End Sub
4

1 に答える 1

1

以下のコードを試してください：

コードを実行する前に、シート B の列にヘッダーを追加してください。また、Worksheet_SelectionChange イベントの手順を使用することをお勧めします。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Application.EnableEvents = False
    On Error Resume Next

    Dim rngFind As Range
    Dim firstCell As String
    Dim i As Integer

    If Target.Column = 1 & Target.Value <> "" Then

        Set rngFind = Sheets("SheetB").Columns(1).Find(What:=Target.Value, LookIn:=xlValues, LookAt:=xlWhole, Searchorder:=xlByRows)

        If Not rngFind Is Nothing Then firstCell = rngFind.Address

        i = 1
        Do While Not rngFind Is Nothing

            Sheets("sheetC").Cells(i, 1).Value = rngFind
            Sheets("sheetC").Cells(i, 2).Value = rngFind.Offset(0, 1)
            Sheets("sheetC").Cells(i, 3).Value = Target.Offset(0, 1)

            i = i + 1
            Set rngFind = Sheets("SheetB").Columns(1).FindNext(rngFind)
            If rngFind.Address = firstCell Then Exit Do
        Loop
    End If

    Application.EnableEvents = True
End Sub
于 2013-05-19T08:20:47.303 に答える