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

PhBarreto

PhBarreto

New Member
Joined
Aug 9, 2016
Messages
17
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Sort by date Sort by votes
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:
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question
VBA optimization advice
Replies
3
Views
146
bobsan42
bobsan42
excelbytes
  • Solved
VBA Code To Copy Data Into Next Blank Column
Replies
5
Views
146
mumps
mumps
J
  • Question
VBA to select partial filename and go back and forth between two files to copy paste
Replies
1
Views
194
shknbk2
S
N
  • Question
VBA Questions - Copying dynamic data from one tab to another and deleting filtered rows
Replies
1
Views
222
DanteAmor
DanteAmor
P
  • Solved
Counter in For Each loop
Replies
2
Views
215
Possum17
P

Forum statistics

Threads
1,215,519
Messages
6,125,298
Members
449,218
Latest member
Excel Master

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top