boa tarde!
fiz um código para que ele abra 7 planilhas que contem algumas pelo menos 2 abas em cada planilha e faça uma comparação, se a comparação tiver ok,, ele copia a linha toda( que na planilha original corresponde as semanas( semana 01 até a semana 52, ou seja 1 ano) e cola na planilha banco de dados 03 - vertices ("BD-03 VERTICES").
o problema é que ao executar esta fechando o excel (o excel parou de funcionar.. reiniciando o excel).
alguma sugestão para que melhore esse problema?
coloquei só a primeira parte do código aqui embaixo.
Sub atualiza()
Application.ScreenUpdating = False
Dim i As Long
ActiveWorkbook.RefreshAll
Plan2.Select
s = "01. Vertice 1.xlsx"
h = "02. Vertice 2.xlsx"
w = "03. Vertice 3.xlsx"
k = "04. Vertice 4.xlsx"
l = "06. Vertice 5.xlsx"
m = "07. Vertice 7.xlsx"
e = "08. Vertice 8.xlsx"
i = (Cells(Rows.Count, 1).End(xlUp).Row)
r = (Cells(1, Columns.Count).End(xlToLeft).Column)
Workbooks.Open ("M:QualidadeGarantia da Qualidade9. Poligono da Qualidade3. Vertices1. Vertice Sustentabilidade.xlsx")
For x = 3 To i
For j = 3 To 28
'''VERTICE 01
'indicador1.1
If Workbooks(s).Worksheets("indicador1.1").Cells(j, 4).Value = ThisWorkbook.Worksheets("BD-03 VERTICES").Cells(x, 6).Value And Workbooks(s).Worksheets("indicador1.1").Cells(j, 4).Value <> "" Then
Workbooks(s).Activate
Workbooks(s).Worksheets("indicador1.1").Select
Workbooks(s).Worksheets("indicador1.1").Range(Cells(j, 5), Cells(j, r)).Select
Selection.Copy
ThisWorkbook.Activate
Plan2.Select
Plan2.Cells(x, 10).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
'indicador1.2
If Workbooks(s).Worksheets("indicador1.2").Cells(j, 4).Value = ThisWorkbook.Worksheets("BD-03 VERTICES").Cells(x, 6).Value And Workbooks(s).Worksheets("indicador1.2").Cells(j, 4).Value <> "" Then
Workbooks(s).Activate
Workbooks(s).Worksheets("indicador1.2").Select
Workbooks(s).Worksheets("indicador1.2").Range(Cells(j, 6), Cells(j, r)).Select
Selection.Copy
ThisWorkbook.Activate
Plan2.Select
Plan2.Cells(x, 10).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If
'Iindicador1.3
If Workbooks(s).Worksheets("indicador1.3").Cells(j, 4).Value = ThisWorkbook.Worksheets("BD-03 VERTICES").Cells(x, 6).Value And Workbooks(s).Worksheets("indicador1.3").Cells(j, 4).Value <> "" Then
Workbooks(s).Activate
Workbooks(s).Worksheets("indicador1.3").Select
Workbooks(s).Worksheets("indicador1.3").Range(Cells(j, 6), Cells(j, r)).Select
Selection.Copy
ThisWorkbook.Activate
Plan2.Select
Plan2.Cells(x, 10).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If
'indicador1.4
If Workbooks(s).Worksheets("indicador1.4").Cells(j + 14, 4).Value = ThisWorkbook.Worksheets("BD-03 VERTICES").Cells(x, 6).Value And Workbooks(s).Worksheets("indicador1.4").Cells(j + 14, 4).Value <> "" Then
Workbooks(s).Activate
Workbooks(s).Worksheets("indicador1.4").Select
Workbooks(s).Worksheets("indicador1.4").Range(Cells(j + 14, 5), Cells(j + 14, r)).Select
Selection.Copy
ThisWorkbook.Activate
Plan2.Select
Plan2.Cells(x, 10).Select
'ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If
Next
Next
Workbooks(s).Close
obrigado desde já!
Postado : 11/04/2016 1:19 pm