Macro para varias hojas con distinto nombre
Me hiciste esta macro, pero ahora tengo otra cosa,
Donde pone hoja = "180.3T", esa hoja puede tener varios nombres como por ejemplo, 180, 180.1t, 180.2t. 180. Ok. 3t, ¿Hay alguna manera que la macro se ejecute en todas las hojas? Lo que siempre tienen en común es 180
Como siempre agradecido estoy
Sub Resumen()
'Por.Dante Amor
Application.Calculation = xlCalculationManual '==> esto me dice que es para que vaya mas rapido quitar si da error
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Resumen")
h1.Rows("2:" & Rows.Count).Clear
'
'ruta = "C:\GENAR - ASESMAG17\CONTABILIDAD 2017\ALFONSO CONTABILIDAD 2017\"
ruta = ThisWorkbook.Path & "\"
arch = Dir(ruta & "*.xls*")
hoja = "180.3T"
j = 2
Do While arch <> ""
If arch <> l1.Name Then
Set l2 = Workbooks.Open(ruta & arch)
existe = False
For Each h In l2.Sheets
If UCase(h.Name) = hoja Then
existe = True
Exit For
End If
Next
If existe = True Then
Set h2 = l2.Sheets(hoja)
'ES PARA QUE LO COPIE COMO VALOR EN LA HOJA DE 180
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'====================================================
For i = 3 To 30
If h2.Cells(i, "G") <> 0 Then
h2.Rows(i).Copy h1.Rows(j)
h1.Cells(j, "AA") = h2.Range("B1")
j = j + 1
End If
Next
End If
l2.Close False
End If
j = j + 1
arch = Dir()
Loop
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic '==> esto me dice que es para que vaya mas rapido quitar si da error
MsgBox " Resumen terimado ", vbInformation, "RESUMEN"
End Sub