There is a way to optimize this CODE? MRS EXCEL - PLS HELP!!

PhBarreto

New Member
Joined
Aug 9, 2016
Messages
9
Hello guys!

I have a spreadsheet with 30 sheets and I have the code bellow to.
There is a way to optimize this CODE?
I want a smaller code. What do the same thing for all sheets... and if error, loop or go to next.


Sub CopiarPainelEntregas()
Dim LR As Long
Dim resposta As Integer
Dim YesOrNoAnswerToMessageBox As String
Dim QuestionToMessageBox As String




Application.ScreenUpdating = False

If Sheets("Painel de Entregas").Range("A12").Value <> "" Then
YesOrNoAnswerToMessageBox = MsgBox("Você tem certeza que deseja ATUALIZAR o Painel de Entregas?", vbYesNo, "Atualizar Painel de Entregas")


If YesOrNoAnswerToMessageBox = vbNo Then
Exit Sub

Else
Sheets("Painel de Entregas").Select
Range("A12:I3000").Select
Selection.ClearContents
Range("A11").Select
End If
End If

'ABA 1

On Error GoTo infome

LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("c12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("c12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If


'ABA 2

LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("d12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("d12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If


'ABA 3


LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("e12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("e12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If


'ABA 4


LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("f12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("f12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If


'ABA 5

LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("g12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("g12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If


'ABA 6


LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("h12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("h12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If


'ABA 7



LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("i12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("i12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If


'ABA 8

LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("j12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("j12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If


'ABA 9



LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("k12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("k12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If



'aba 10


LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("L12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("L12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If



'ABA 11




LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("M12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("M12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If


'aba 12



LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("N12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("N12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If


'ABA 13



LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("O12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("O12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If

'ABA 14


LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("P12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("P12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If


'ABA 15


LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("Q12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("Q12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If



'ABA 16


LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("R12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("R12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If



'ABA 17


LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("S12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("S12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If


'ABA 18


LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("T12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("T12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If



'ABA 19


LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("U12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("U12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If




'ABA 20


LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("V12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("V12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If


'ABA 21


LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("W12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("W12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If



'ABA 22


LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("X12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("X12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If



'ABA 23


LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("Y12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("Y12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If



'ABA 24



LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("Z12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("Z12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If


'ABA 25


LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("AA12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("AA12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If



'ABA 26



LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("AB12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("AB12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If


'ABA 27



LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("AC12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("AC12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If



'ABA 28


LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("AD12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("AD12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If



'ABA 29



LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("AE12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("AE12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If



'ABA 30



LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Painel").Select
Sheets(Range("AF12").Value).Select
Range("b08").Select

If Range("b8").Value = "" Then


Else
Range("b08").Select
Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Painel de Entregas").Select
Range("a11").Select
Sheets("Painel").Select
Sheets(Range("AF12").Value).Select
Range("b06").Select
Application.CutCopyMode = False
End If


MsgBox ("Painel de Entregas atualizado com sucesso!")

Sheets("Painel").Select

Exit Sub

infome:
MsgBox ("Erro! Contate o criador da planilha!")
Exit Sub

Application.ScreenUpdating = True

Sheets("Painel").Select

End Sub
 

Kenneth Hobson

Well-known Member
Joined
Feb 6, 2007
Messages
3,092
Welcome to the forum! When pasting code, paste between code tags. Insert code tags by clicking the # icon a message's toolbar.

I would recommend just doing i=1 to 1 for the first check. You will probably want to replace "Sheet" with "ABA ".

You should also consider not using Select or Activate. They are seldom needed.
Code:
Sub Main()
  Dim i As Integer
  For i = 1 To 4
    DoSheet ("Sheet" & i)
  Next i
End Sub

Sub DoSheet(aSheetName As String)
  If Not WorkSheetExists(aSheetName) Then Exit Sub
  With Worksheets(aSheetName)
    'Replace Msgbox with your code to execute for each sheet.  Note period in .Range.
    MsgBox .Range("A1").Address(External:=True) 'Test line to show that it works.
  End With
End Sub

 'WorkSheetExists in a workbook:
Function WorkSheetExists(sWorkSheet As String, Optional sWorkbook As String = "") As Boolean
    Dim ws As Worksheet, wb As Workbook
    On Error GoTo notExists
    If sWorkbook = "" Then
      Set wb = ActiveWorkbook
      Else
      Set wb = Workbooks(sWorkbook) 'sWorkbook must be open already.  e.g. ken.xlsm, not x:\ken.xlsm.
    End If
    Set ws = wb.Worksheets(sWorkSheet)
    WorkSheetExists = True
    Exit Function
notExists:
    WorkSheetExists = False
End Function
 
Last edited:

PhBarreto

New Member
Joined
Aug 9, 2016
Messages
9
Tks for your reply Kenneth Hobson!

I tried to follow your advice and got lost on the way...
Bellow is the main code, and will be the same thing for other 29 sheets.
I have a sheet with the names of others sheets on range c10:AF10, and I want the code go from sheet to sheet based on range C10:F10 (sheets name) and run the activities of the main code.

To go through this range is something like For i = 1 To Cells (Rows.Count, 10, 3) .End (xlToRight) .Row?
How can i do to this code works like a charm?

aba means sheet in Brazil. I'm Brazilian!
lol

Code:
  LR = Sheets("Painel de Entregas").Cells(Rows.Count, 1).End(xlUp).Row  Sheets("Painel").Select
  Sheets(Range("c12").Value).Select
  Range("b08").Select
  
  If Range("b8").Value = "" Then
   
      
  Else
  Range("b08").Select
  Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    
  Selection.Copy
  Sheets("Painel de Entregas").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
  Sheets("Painel de Entregas").Select
  Range("a11").Select
  Sheets("Painel").Select
  Sheets(Range("c12").Value).Select
  Range("b06").Select
  Application.CutCopyMode = False
  End If
 

PhBarreto

New Member
Joined
Aug 9, 2016
Messages
9
Hey Kenneth, just to you know, i created 3 VBA codes and works fine to me.
and to other people that will have a similar problem.


CODE 1
Code:
Sub ApagaDadosRotas()

Application.ScreenUpdating = False


On Error Resume Next


Sheets("ApoioDados").Select
'formata coluna A como texto
Columns("A:A").NumberFormat = "@"


'varre todos os nomes na coluna A
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
'nome escrito em B
Sheets("ApoioDados").Select


'seleciona aba
Sheets(Range("A" & i).Text).Select




    Range("B8:L3000").Select
    Selection.ClearContents
    Range("B8").Select


Next




'habilita atualização de tela


Sheets("Painel").Select


Application.ScreenUpdating = True
   
  Exit Sub


End Sub
CODE 2
Code:
Sub InserePCDRotas()

Application.ScreenUpdating = False




On Error Resume Next


    Sheets("PCD").Select
    Range("B4").Select
    
   
    'varre todos os nomes na coluna w
    For i = 2 To Cells(Rows.Count, 23).End(xlUp).Row
        
    Selection.AutoFilter Field:=11, Criteria1:=Range("W" & i).Value
    Range(Selection, Selection.End(xlDown).End(xlDown).End(xlUp)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    
    Sheets(Range("W" & i).Text).Select
    Range("B7").Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Range("I8:I3000").Select
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("I8"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("B8:L3000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Range("B7:L7").Select
    Selection.Font.Bold = True
    Range("B8").Select


    Sheets("PCD").Select
    Application.CutCopyMode = False
    Range("B4").Select
    ActiveSheet.Range("$B$4:$L$3000").AutoFilter Field:=11
    
    Next
    
    
   'habilita atualização de tela


    Sheets("Painel").Select


    Application.ScreenUpdating = True




    
    End Sub
and CODE 3 It is only to call previous codes

Code:
Sub OrganizaRota()'
' rota01copiacola Macro
'


'


 On Error GoTo aviso


  Dim YesOrNoAnswerToMessageBox As String
      
    YesOrNoAnswerToMessageBox = MsgBox("Você tem certeza que deseja ORGANIZAR todas as ROTAS?", vbYesNo, "Organizar Rotas")
            
    If YesOrNoAnswerToMessageBox = vbNo Then
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    Call ApagaDadosRotas
    
    Call InserePCDRotas
    
   Application.ScreenUpdating = True
         
    MsgBox "Todas as rotas foram organizadas com sucesso!", vbInformation, "Oganizador de Rotas"
    
    
    Exit Sub
     
    
aviso:         MsgBox "Erro! Algumas referências foram perdidas.", vbCritical, "Organizador de Rotas"


 Exit Sub


    Sheets("Painel").Select
    
      
 End Sub
Thank you very much. You pointed to me the right way.
 

Forum statistics

Threads
1,081,727
Messages
5,360,913
Members
400,602
Latest member
newaqua

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top