Bom Dia
Tem como simplificar este monstro???
Sub fMain()
Dim lng As Long
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Set wks1 = ThisWorkbook.Sheets("BALANCETE ANUAL")
Set wks2 = ThisWorkbook.Sheets("JAN")
With wks1
For lng = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If Not IsError(Application.Match _
(.Cells(lng, "A"), wks2.Columns("A"), 0)) Then
'Identifica em qual linha foi encontrado o valor
nl = Application.Match(.Cells(lng, "A"), wks2.Columns("A"), 0)
wks1.Cells(lng, "C") = wks2.Range("C" & nl)
wks1.Cells(lng, "D") = wks2.Range("D" & nl)
wks1.Cells(lng, "E") = wks2.Range("E" & nl)
wks1.Cells(lng, "F") = wks2.Range("F" & nl)
Else
End If
Next lng
End With
Set wks2 = ThisWorkbook.Sheets("FEV")
With wks1
For lng = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If Not IsError(Application.Match _
(.Cells(lng, "A"), wks2.Columns("A"), 0)) Then
'Identifica em qual linha foi encontrado o valor
nl = Application.Match(.Cells(lng, "A"), wks2.Columns("A"), 0)
wks1.Cells(lng, "G") = wks2.Range("C" & nl)
wks1.Cells(lng, "H") = wks2.Range("D" & nl)
wks1.Cells(lng, "I") = wks2.Range("E" & nl)
wks1.Cells(lng, "J") = wks2.Range("F" & nl)
Else
End If
Next lng
End With
Set wks2 = ThisWorkbook.Sheets("MAR")
With wks1
For lng = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If Not IsError(Application.Match _
(.Cells(lng, "A"), wks2.Columns("A"), 0)) Then
'Identifica em qual linha foi encontrado o valor
nl = Application.Match(.Cells(lng, "A"), wks2.Columns("A"), 0)
wks1.Cells(lng, "K") = wks2.Range("C" & nl)
wks1.Cells(lng, "L") = wks2.Range("D" & nl)
wks1.Cells(lng, "M") = wks2.Range("E" & nl)
wks1.Cells(lng, "N") = wks2.Range("F" & nl)
Else
End If
Next lng
End With
Set wks2 = ThisWorkbook.Sheets("ABR")
With wks1
For lng = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If Not IsError(Application.Match _
(.Cells(lng, "A"), wks2.Columns("A"), 0)) Then
'Identifica em qual linha foi encontrado o valor
nl = Application.Match(.Cells(lng, "A"), wks2.Columns("A"), 0)
wks1.Cells(lng, "S") = wks2.Range("C" & nl)
wks1.Cells(lng, "T") = wks2.Range("D" & nl)
wks1.Cells(lng, "U") = wks2.Range("E" & nl)
wks1.Cells(lng, "V") = wks2.Range("F" & nl)
Else
End If
Next lng
End With
Set wks2 = ThisWorkbook.Sheets("MAI")
With wks1
For lng = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If Not IsError(Application.Match _
(.Cells(lng, "A"), wks2.Columns("A"), 0)) Then
'Identifica em qual linha foi encontrado o valor
nl = Application.Match(.Cells(lng, "A"), wks2.Columns("A"), 0)
wks1.Cells(lng, "W") = wks2.Range("C" & nl)
wks1.Cells(lng, "X") = wks2.Range("D" & nl)
wks1.Cells(lng, "Y") = wks2.Range("E" & nl)
wks1.Cells(lng, "Z") = wks2.Range("F" & nl)
Else
End If
Next lng
End With
Set wks2 = ThisWorkbook.Sheets("JUN")
With wks1
For lng = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If Not IsError(Application.Match _
(.Cells(lng, "A"), wks2.Columns("A"), 0)) Then
'Identifica em qual linha foi encontrado o valor
nl = Application.Match(.Cells(lng, "A"), wks2.Columns("A"), 0)
wks1.Cells(lng, "AA") = wks2.Range("C" & nl)
wks1.Cells(lng, "AB") = wks2.Range("D" & nl)
wks1.Cells(lng, "AC") = wks2.Range("E" & nl)
wks1.Cells(lng, "AD") = wks2.Range("F" & nl)
Else
End If
Next lng
End With
Set wks2 = ThisWorkbook.Sheets("JUL")
With wks1
For lng = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If Not IsError(Application.Match _
(.Cells(lng, "A"), wks2.Columns("A"), 0)) Then
'Identifica em qual linha foi encontrado o valor
nl = Application.Match(.Cells(lng, "A"), wks2.Columns("A"), 0)
wks1.Cells(lng, "AI") = wks2.Range("C" & nl)
wks1.Cells(lng, "AJ") = wks2.Range("D" & nl)
wks1.Cells(lng, "AK") = wks2.Range("E" & nl)
wks1.Cells(lng, "AL") = wks2.Range("F" & nl)
Else
End If
Next lng
End With
Set wks2 = ThisWorkbook.Sheets("AGO")
With wks1
For lng = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If Not IsError(Application.Match _
(.Cells(lng, "A"), wks2.Columns("A"), 0)) Then
'Identifica em qual linha foi encontrado o valor
nl = Application.Match(.Cells(lng, "A"), wks2.Columns("A"), 0)
wks1.Cells(lng, "AM") = wks2.Range("C" & nl)
wks1.Cells(lng, "AN") = wks2.Range("D" & nl)
wks1.Cells(lng, "AO") = wks2.Range("E" & nl)
wks1.Cells(lng, "AP") = wks2.Range("F" & nl)
Else
End If
Next lng
End With
Set wks2 = ThisWorkbook.Sheets("SET")
With wks1
For lng = 1 To .Cells(.Rows.Count, "A").End(xlUp).RowRegras do fórum
Sua dúvida foi respondida? Marque como RESOLVIDO em seus tópicos, usando o botão com marca verde.
Criar um novo tópico
Título:Cor do texto:
Minúscula Pequena Normal Grande Enorme
If Not IsError(Application.Match _
(.Cells(lng, "A"), wks2.Columns("A"), 0)) Then
'Identifica em qual linha foi encontrado o valor
nl = Application.Match(.Cells(lng, "A"), wks2.Columns("A"), 0)
wks1.Cells(lng, "AQ") = wks2.Range("C" & nl)
wks1.Cells(lng, "AR") = wks2.Range("D" & nl)
wks1.Cells(lng, "AS") = wks2.Range("E" & nl)
wks1.Cells(lng, "AT") = wks2.Range("F" & nl)
Else
End If
Next lng
End With
Set wks2 = ThisWorkbook.Sheets("OUT")
With wks1
For lng = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If Not IsError(Application.Match _
(.Cells(lng, "A"), wks2.Columns("A"), 0)) Then
'Identifica em qual linha foi encontrado o valor
nl = Application.Match(.Cells(lng, "A"), wks2.Columns("A"), 0)
wks1.Cells(lng, "AY") = wks2.Range("C" & nl)
wks1.Cells(lng, "AZ") = wks2.Range("D" & nl)
wks1.Cells(lng, "BA") = wks2.Range("E" & nl)
wks1.Cells(lng, "BB") = wks2.Range("F" & nl)
Else
End If
Next lng
End With
Set wks2 = ThisWorkbook.Sheets("NOV")
With wks1
For lng = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If Not IsError(Application.Match _
(.Cells(lng, "A"), wks2.Columns("A"), 0)) Then
'Identifica em qual linha foi encontrado o valor
nl = Application.Match(.Cells(lng, "A"), wks2.Columns("A"), 0)
wks1.Cells(lng, "BC") = wks2.Range("C" & nl)
wks1.Cells(lng, "BD") = wks2.Range("D" & nl)
wks1.Cells(lng, "BE") = wks2.Range("E" & nl)
wks1.Cells(lng, "BF") = wks2.Range("F" & nl)
Else
End If
Next lng
End With
Set wks2 = ThisWorkbook.Sheets("DEZ")
With wks1
For lng = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If Not IsError(Application.Match _
(.Cells(lng, "A"), wks2.Columns("A"), 0)) Then
'Identifica em qual linha foi encontrado o valor
nl = Application.Match(.Cells(lng, "A"), wks2.Columns("A"), 0)
wks1.Cells(lng, "BG") = wks2.Range("C" & nl)
wks1.Cells(lng, "BH") = wks2.Range("D" & nl)
wks1.Cells(lng, "BI") = wks2.Range("E" & nl)
wks1.Cells(lng, "BJ") = wks2.Range("F" & nl)
Else
End If
Next lng
End With
End Sub