Preciso de ajuda para diminuir meu código

Olá, alguém pode me ajudar a diminuir esse código para mim? Achei bem grande e acho que tem como deixar menor, porém não sei como fazer.

Funciona assim, tenho uma planilha com todos os meses, separados com 5 semanas cada, em outra aba tenho uma macro, no caso essa que colocarei abaixo que identifica através da célula B29 (29,2) o número da semana que vai de 1 a 5 e a célula B30 (30,2) que pega o mês, indo de 1 a 12. Nesse código só tem o mês de Janeiro, eu fiz esse mesmo código para todos os outros meses e ficou enorme.

'Janeiro

Application.ScreenUpdating = False

'Semana 1

'29,2 é onde fica o n° da semana e 30,2 o n° mês

If Cells(29, 2) = “1” And Cells(30, 2) = “1” Then
Range(“B17”).Select 'B17 é o valor que será passado para outra aba
Selection.Copy
Sheets(“Lucro por Mês-Ano”).Select
Range(“B39”).Select 'é a célula onde sera colado o valor de B17
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(“B4”).Select 'Apenas deixa a célula selecionada
Unload UserForm6
Sheets(“Lucro por Dia”).Select
MsgBox “Valor registrado!”, vbInformation, “Ganhos na Semana”
End If

'Semana 2

If Cells(29, 2) = “2” And Cells(30, 2) = “1” Then
Range(“B17”).Select
Selection.Copy
Sheets(“Lucro por Mês-Ano”).Select
Range(“B40”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(“B4”).Select
Unload UserForm6
Sheets(“Lucro por Dia”).Select
MsgBox “Valor registrado!”, vbInformation, “Ganhos na Semana”
End If

'Semana 3

If Cells(29, 2) = “3” And Cells(30, 2) = “1” Then
Range(“B17”).Select
Selection.Copy
Sheets(“Lucro por Mês-Ano”).Select
Range(“B41”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(“B4”).Select
Unload UserForm6
Sheets(“Lucro por Dia”).Select
MsgBox “Valor registrado!”, vbInformation, “Ganhos na Semana”
End If

'Semana 4

If Cells(29, 2) = “4” And Cells(30, 2) = “1” Then
Application.ScreenUpdating = True
Range(“B17”).Select
Selection.Copy
Sheets(“Lucro por Mês-Ano”).Select
Range(“B42”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(“B4”).Select
Unload UserForm6
Sheets(“Lucro por Dia”).Select
MsgBox “Valor registrado!”, vbInformation, “Ganhos na Semana”
End If

'Semana 5

If Cells(29, 2) = “5” And Cells(30, 2) = “1” Then
Range(“B17”).Select
Selection.Copy
Sheets(“Lucro por Mês-Ano”).Select
Range(“B43”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(“B4”).Select
Unload UserForm6
Sheets(“Lucro por Dia”).Select
MsgBox “Valor registrado!”, vbInformation, “Ganhos na Semana”
End If
Application.ScreenUpdating = True

Bom dia Henrique.
Há várias formas de fazer, mas como não tenho a sua planilha para todos os meses, criei uma rotina que vai satisfazer todos os meses. Coloquei uma rotina no módulo 1 e uma na Plan1.
Estou te mandando um arquivo e se não entender, me avise que lhe ajudo.
Temos 4 itens que eu creio que você irá alterar a cada mês, pois pode haver meses com 4 semanas ou com 6 semanas, pelo menos pensei assim. A ordem é semana, mês, célula origem e célula destino.

henrique1473.xlsm (16,8,KB)

abs

Obrigado amigo, consegui fazer aqui e ajudou muito, muito obrigado!