안녕하세요?

지;난번 문의드린 내용인데 이리 저리 궁리해봐도 계속 코드 자체가

작동하지 않아 작업파일을 첨부하여 다시 한번 도움을 요청드립니다

원래 의도는 F열의 어떤 셀(상호값)을 선택하여 더블클릭하든 바로 그 G열 셀에 상호별 담당자 콤보박스가 나타나 담당자를 선택만 하면 되도록 하는 것이었느데 그 정도까지VBA를 만들수 없어서 아래처럼 편법을 쓰고자 하는 것입니다 (I2열 담당자셀에 콤보박스를 성정하였음), 더 좋은 아이디어가 있으시면 조언부탁드립니다

1~2번 명열을 하나의; VBA에 동시에 담을 수 없다면 VBA 따로 생성허고 싶습니다

1. F5 이하 F열 셀(상호 K) 을 더블클릭하면 클릭한 셀 값이 G2(샘플업체명G)에 복사
2. G5 이하 G열 셀(빈 셀)을 더블클릭시 I2셀 값(윤대리)이 더블 클릭한 G열 셀로 복사

VBA 왕초보가 일단 만들어 본 코드입니다

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim rngA, rngB As Range

Dim strA, strB AS String

If Not Intersect(Target, rngA) Is Nothing Then
Application.EnableEvents = False

Set rngA = Range("F5 : F" & Range("B2"))
Set strA = Cells(2.7)

If ActiveCell.Value = "" Then Exit Sub

Else

If Not Intersect(ActiveCell.rngA) Is Nothing Then
ActiveCell.Value.Copy
ActiveCell.Value.PasteSpecial.xlPasteValue

End If

Cancel = True

Application.EnableEvents = True

 

If Not Intersect(Target, rngB) Is Nothing Then
Application.EnableEvents = False

Set rngB = Range("G5 : G" & Range("B2"))
Set strB = Cells(2.9)

IF RngB.ActiveCell .DoubleClick

strB , Value.Copy
rngB.ActiveCell.PasteSpecial.xlPasteValue

End If

Cancel = True

Application.EnableEvents = True

End Sub

 

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim rngA As Range, rngB As Range
Dim intA As Integer


intA = Sheet9.Cells(Rows.Count, 3).End(xlUp).Row

Set rngA = Sheet9.Range(Sheet9.Cells(5, 6), Sheet9.Cells(intA, 6))
Set rngB = Sheet9.Range(Sheet9.Cells(5, 7), Sheet9.Cells(intA, 7))

Application.EnableEvents = False

If Not Intersect(Target, rngA) Is Nothing Then
    
    
    If ActiveCell.Value = "" Then
        GoTo End1
    Else
        Sheet9.Cells(2, 7) = ActiveCell.Value
    End If

ElseIf Not Intersect(Target, rngB) Is Nothing Then
    ActiveCell.Value = Sheet9.Cells(2, 9)
    
End If

End1:

Cancel = True
Application.EnableEvents = True


End Sub