Question

这是我在Stack Overflow中的第一篇文章，所以我犯的任何错误都请忽略。

因此，我做了一个运行应用程序输入框宏的按钮，您在输入框中输入的名称将使用您输入的名称创建一个新的工作表，它还将在新工作表上创建一个表格。您在输入框上输入的名称是新来的客户，因此我将为每个来的客户提供带有表的特定工作表。

另一方面，我得到了将从客户那里获得收入的工人，我有4个工人都有自己的收入表和收益表。

现在我要解决的问题是，是否可以在VBA上编写如下代码：如果在新表上（在表内，具体来说：K8：K23，K28：K43，K49：K64）插入了Worker的名称，复制客户端的名称并将其粘贴到Worker的现有工作表中。

我尝试过但没有用的代码：（仅检查First Sub和行尾，代码之间只是用于创建表的一堆宏，该部分可以正常工作，这是我的代码存在的问题位于最后的地方是它什么也没做，是的，我故意对代码进行了表扬）

    Sub KerkimiKlientit()
        Dim EmriKlientit As String
        Dim rng As Range, cel As Range
        Dim OutPut As Integer

    retry:

        EmriKlientit = Application.InputBox("Shkruani Emrin e Klientit", "Kerkimi")
        If Trim(EmriKlientit) <> "" Then
            With Sheets("Hyrjet").Range("B10:B200")
                Set rng = .Find(What:=EmriKlientit, _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
                If Not rng Is Nothing Then
    sheet:
                    Flag = 0
                    Count = ActiveWorkbook.Worksheets.Count
                        For i = 1 To Count
                            WS_Name = ActiveWorkbook.Worksheets(i).Name
                            If WS_Name = EmriKlientit Then Flag = 1
                        Next i
                            If Flag = 1 Then
                                ActiveWorkbook.Sheets(EmriKlientit).Activate
                                Exit Sub
                            Else
                                Sheets.Add(, Sheets(Sheets.Count)).Name = EmriKlientit
                                Call KrijimiTabeles(EmriKlientit)
                                Exit Sub
                            End If

                Else
                    OutPut = MsgBox("Klienti nuk u gjet", vbRetryCancel + vbInformation, "Provoni Perseri")
                        If (OutPut = vbRetry) Then
                            GoTo retry:
                        ElseIf (OutPut = vbCancel) Then
                            Exit Sub
                        End If
                    Exit Sub
                End If
            End With
        End If
        If userInputValue = "" Then
            OutPut = MsgBox("Rubrika e Emrit e zbrazet", vbRetryCancel + vbExclamation, "Gabim")
                If (OutPut = vbRetry) Then
                    GoTo retry:
                ElseIf (OutPut = vbCancel) Then
                    Exit Sub
                End If
        Else
            GoTo retry:
        End If
    End Sub

    Sub KrijimiTabeles(EmriKlientit As String)
    '
    ' KrijimiTabeles Macro
    '

    'This was just an middle code, it was too long so I did not paste it. Not an important part tho.







   'This is the part that does not work, it just does nothing for some reason, there are multiple codes here and I tried them all.

    'Sub Formula(EmriKlientit As String, ByVal Target As Range)
        'ActiveWorkbook.Sheets(EmriKlientit).Activate
        'If Not Application.Intersect(Range("K8:K23"), Range(Target.Adress)) Is Nothing Then
        'Call Formula1
        'End If
    'End Sub
    'Dim LR As Long, i As Long
        'Application.ScreenUpdating = False
        'Dim Rng As Range
        'For Each Rng In Range("K8:K23")
            'Select Case Rng.Value
                'Case "M"
                    'Worksheets(EmriKlientit).Range("K2").Copy
                    'Worksheets("Mustafa").Range("K6").PasteSpecial Paste:=xlPasteFormulas
            'End Select
        'Next Rng
        'Application.ScreenUpdating = True
        'For Each cel In Rng
            'If cel.Value = "M" Then
                'Worksheets(EmriKlientit).Range("K2").Copy
                'Worksheets("Mustafa").Range("K6").PasteSpecial Paste:=xlPasteFormulas
            'End If
        'Next cel


    'ActiveWorkbook.Sheets(EmriKlientit).Activate
        'If Not Application.Intersect(Range("K8:K23"), Range(Rng.Adress)) Is Nothing Then
            'With Sheets(EmriKlientit)
                'With .Range("K8:K23")
                    'If .Text = "M" Then
                        'Worksheets(EmriKlientit).Range("K2").Copy
                        'Worksheets("Mustafa").Range("K6").PasteSpecial Paste:=xlPasteFormulas
                    'End If
                'End With
            'End With
        'End If
        'Flag = 0
            'Count = ActiveWorkbook.Worksheets.Count
                'For i = 1 To Count
                    'WS_Name = ActiveWorkbook.Worksheets(i).Name
                    'If WS_Name = EmriKlientit Then Flag = 1
                        'Next i
                            'If Flag = 1 Then
                                'ActiveWorkbook.Sheets(EmriKlientit).Activate
                                    'For Each Cell In Sheets(EmriKllientit).Range("K8:K23")
                                        'If Cell.Value = "M" Then
                                            'Range("K2").Copy
                                            'Worksheets("Mustafa").Range("K6").PasteSpecial Paste:=xlPasteFormulas
                                        'End If
                                    'Next
                            'End If

    End Sub

谢谢

我希望我足够清楚，任何帮助将不胜感激。

Answer 1

欢迎使用StackOverflow-我同意您的问题可以更具体一些...

我认为您要实现的目标介于以下两行之间：

Dim wsClient As Worksheet, wsMustafa As Worksheet
Dim i As Long
Dim fRow As Long, lRow As Long

Set wsClient = ActiveWorkbook.Sheets("Client")
Set wsMustafa= ActiveWorkbook.Sheets("Mustafa")

'you can assign this through better ways, but to start with...
fRow = 8
lRow = 23

For i = fRow To lRow
    If wsClient.Range("K" & i).Value = "M" Then
        wsMustafa.Range("K6").Value = wsClient.Range("K" & i).Value 'or .Formula if that's what you want
    End If
Next i

希望这会有所帮助，祝你好运。

将新添加的工作表连接到现有的工作表

1 个答案: