Como pergunta no título, quero atualizar os valores de uma planilha de cada nova planilha criada por uma macro que fiz. Fiz uma execução de macro quando inseri o nome do cliente na caixa de entrada que é executada depois que você clica em um botão. (Imagem 2)
Quando o nome do cliente estiver correto, a macro criará automaticamente uma planilha, nomeando-a após o nome do cliente e também criará uma nova tabela para esse cliente (o formato da tabela não será alterado em nenhum cliente).
Nessa tabela, os valores serão inseridos, como o valor da receita, a data dessa renda e qual dos Trabalhadores recebeu a renda. Especificamente na célula "I8" será inserido o valor, em "J8" a data será inserida e mais importante em "K8" o nome do Trabalhador que tomou a renda será inserido, este passará para as outras receitas de o cliente "I9", "J9", "K9" e depois "I10", "J10", "K10" e assim por diante (Imagem 3).
A Tabela que eu criei para essas 4 folhas de Trabalhadores existentes é mostrada na Imagem 1, assim em "A10", "A12", "A14" e assim por diante o nome dos clientes que o trabalhador obteve a renda de será colado (esperançosamente). se o nome do cliente estiver em "A10", o montante de rendimento que o trabalhador receberá será automaticamente introduzido (esperamos que de novo) em "C10", "D10", "E10", "F10" e "G10". data em que ele obteve a renda "C11", "D11", "E11", "F11" e "G11", o mesmo vale se o Trabalhador obtiver renda de outros clientes (Ex: "A12" - > "C12" = Valor , "C13" = Data, "D12" "C13" e assim por diante), veja a Imagem 1.
(lembre-se de que há 5 diferentes ocasiões em que um cliente pode enviar receitas, por isso existem 5 colunas para a renda)
Agora, a questão é que preciso de um código que seja automaticamente:
O código de macro que eu fiz não funcionou (eles acabaram com um erro e até mesmo corrigir o erro não fez nada, ou simplesmente nada mudou na folha de trabalho se eu inserir qualquer valor na nova planilha de cliente).
Nota: O Primeiro Sub é apenas o código da Caixa de Entrada da aplicação e a Formação da Folha, o Segundo Sub é a formação da Tabela e no final são os códigos que eu comentei, porque nenhum deles funcionou.
Imagem 1: link
Imagem 2: link
Imagem 3: link
Se você não entender o código abaixo por causa do formato, veja os códigos exibidos na imagem:
Imagem de código 1: link
Imagem de código 2: link
Imagem de código 3: link
Imagem de código 4: link
Function WorksheetExists2(WorksheetName As String, Optional wb As Workbook) As Boolean
If WorksheetExists2(EmriKlientit) Then
ActiveWorkbook.Sheets(EmriKlientit).Activate
Else
GoTo sheet:
End Function
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 a big line of the Table creation, not important because it works perfectly.
'And these are the codes I used, all of these did not work because they either did not update or either ended up with errors and even fixing them won't change anything, the recent code I used is the uncommented one.
Dim wsClient As Worksheet, wsMustafa As Worksheet
Dim i As Long
Dim fRow As Long, lRow As Long
Set wsClient = ActiveWorkbook.Sheets(EmriKlientit)
Set wsMustafa = ActiveWorkbook.Sheets("Mustafa")
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
'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