Agregar info en celdas utilizando macro con bucle

Question

el 30 may. 13

Agregar info en celdas utilizando macro con bucle

tengo una macro depuradora de formatos y letras que se corre para todas las hojas activas del libro excepto una.

a dicha macro le quiero agregar la instrucción de insertar dos columnas, en todas las hojas activas del libro y en una de las columnas agregarle un determinado texto en las filas que contiene.

Lo que me ocurre, es que el bucle que contiene la macro me repite la información que deseo agregar en ésa columna y celdas, tantas veces como hojas activas tenga.

Cómo puedo restringirlo para que se informe ése texto en un determinado lugar de cada hoja activa, pero sólo una vez sin repeticiones.

debajo les dejo mi macro depuradora:

Option Explicit
Sub Macro_Pedidos_all_sheets()
'Macro creada por usuario akmontesdeoca 21-11-2012
'con ella se podrán validar todas las hojas sin necesidad de nombre, etc.
'a su vez las hojas se desprotejeran de forma automática sin necesidad de introducir
'la pasword manual, con un solo click la macro se depura sin problemas
Dim sht, hoja As Worksheet
Dim i As Integer
For Each sht In Sheets
'Corremos un if en donde validamos que sht sea un worksheet y de ser así deshabilitamos el
'password de igual manera evitamos que a la hoja llamada CALCULO pierda 'la protección
If TypeName(sht) = "Worksheet" And Not sht.Name = "CALCULO" Then
sht.Unprotect Password:="11"
'Activamos las hojas y Apliamos aun 135%
sht.Activate
ActiveWindow.Zoom = 135
End If 'Falto la linea que cierra el if
Next sht
'En el siguiente bucle integraras la exclusión para la hoja CALCULO
'................................................................................................................................
'Se ah agregado un ciclo for el caul contara el numero total de las hojas y excluira la hoja con el nombre calculo |
'al momento de desarrollar macros las comillas (")indican que el tipo de dato es String (cadena de texto) |
'por lo tanto en una comparacion se distingiran Mayusculas de minusculas. Ese era uno de los problemas que se tenian |
' Por otro lado no se puede hacer un Remplace desde un For Each en todas las hojas ya que la busqueda guardara |
'Los parametros anteriores y los mostrara como que ya sea realizado el reemplazo |
'Es por eso que el for contara las hojas y se basaran en el numero de Index que tienen para poder ir activando hoja por hoja |
'y de esa manera la busqueda sabra que tiene parametros diferentes |
'................................................................................................................................
For i = 1 To Sheets.Count 'ESTE ES EL FOR QUE INDICA EL NUMERO DE INDEX DE CADA HOJA
For Each hoja In Worksheets
Worksheets(i).Select 'AQUI INDICAMOS QUE LA HOJA SE ACTIVE CON SU NUMERO DE INDEX
If ActiveSheet.Name <> "CALCULO" Then 'de este modo excluirás la hoja CALCULO
'Aquí escribirás todas las sentencias que quieres que se ejecuten en las demás hojas
Cells.Select
Selection.ClearFormats
'con esta instrucción quiero que se le borren los formatos a la hoja
'lo hago para las celdas fusionadas, así no las tengo que eliminar antes
Columns("A:A").Select
Selection.NumberFormat = "0"
Selection.NumberFormat = "0"
Selection.NumberFormat = "@"
'para la columna A = legajo le asigno formato de texto, así veo los números en un solo
'formato
Range("B:B,E:E").Select
Selection.Replace What:="á", Replacement:="a", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="é", Replacement:="e", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="í", Replacement:="i", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="ó", Replacement:="o", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="ú", Replacement:="u", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="ñ", Replacement:="n", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="¥", Replacement:="N", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:=" ", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:=" ", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:=",", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Range("A1").Select
Selection.ColumnWidth = 9
Range("B1").Select
Selection.ColumnWidth = 24
Range("C1").Select
Selection.ColumnWidth = 14
Range("D1").Select
Selection.ColumnWidth = 11
Range("E1").Select
Selection.ColumnWidth = 20
Columns("C:C").Select
Columns("C:C").Select
Selection.NumberFormat = "#,##0.00"
Selection.NumberFormat = "0.00"
Selection.NumberFormat = "0"
Selection.NumberFormat = "0.00"
Columns("A:E").Select
Range("E1").Activate
Selection.Font.Italic = False
Columns("A:E").Select
Range("E1").Activate
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("B:B, D:D, E:E").Select
'se añaden las columnas D y E para eliminar determinados tiles, comas y espacios
Selection.Replace What:=".", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=",", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=";", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="-", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="à", Replacement:="a", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="è", Replacement:="e", LookAt:=xlPart, _
SearchOrder:=xlByRows,...

Answer 1

Haz clic para o

Agregar info en celdas utilizando macro con bucle

Añade tu respuesta