Ver Mensaje Individual
  #7 (permalink)  
Antiguo 03/01/2010, 13:11
LOD_Fredy
 
Fecha de Ingreso: abril-2009
Mensajes: 341
Antigüedad: 15 años
Puntos: 3
Respuesta: Ayuda con macro

Código:
Sub copiarJULAGO()
Dim NuevaHoja As String
Dim row As String
Dim i As Integer, opc As Integer
opc = 4
For i = 3 To 103
'row = CStr(i) ' + 3)
'Row = "3"
Dim letra As String
letra = Switch(i = 3, "B", i = 4, "C", i = 5, "D", i = 6, "E", i = 7, "F", i = 8, "G", _
i = 9, "H", i = 10, "I", i = 11, "J", i = 12, "K", i = 13, "L", i = 14, "M", i = 15, "N", _
i = 16, "O", i = 17, "P", i = 18, "Q", i = 19, "R", i = 20, "S", i = 21, "T", i = 22, "U", i = 23, _
"V", i = 24, "W", i = 25, "X", i = 26, "Y", i = 27, "Z", i = 28, "AA", i = 29, "AB", i = 30, "AC", _
i = 31, "AD", i = 32, "AE", i = 33, "AF", i = 34, "AG", i = 35, "AH", i = 36, "AI", i = 37, "AJ", _
i = 38, "AK", i = 39, "AL", i = 40, "AM", i = 41, "AN", i = 42, "AO", i = 43, "AP", i = 44, "AQ", _
i = 45, "AR", i = 46, "AS", i = 47, "AT", i = 48, "AU", i = 49, "AV", i = 50, "AW", i = 51, "AX", _
i = 52, "AY", i = 53, "AZ", i = 54, "BA", i = 55, "BB", i = 56, "BC", i = 57, "BD", i = 58, "BE", _
i = 59, "BF", i = 60, "BG", i = 61, "BH", i = 62, "BI", i = 63, "BJ", i = 64, "BK", _
i = 65, "BL", i = 66, "BM", i = 67, "BN", i = 68, "BO", i = 69, "BP", i = 70, "BQ", _
i = 71, "BR", i = 72, "BS", i = 73, "BT", i = 74, "BU", i = 75, "BV", i = 76, "BX", _
i = 77, "BY", i = 78, "BZ", i = 79, "CA", i = 80, "CB", i = 81, "CC", i = 82, "CD", _
i = 83, "CE", i = 84, "CF", i = 85, "CG", i = 86, "CH", i = 87, "CI", i = 88, "CJ", _
i = 89, "CK", i = 90, "CL", i = 91, "CM", i = 92, "CN", i = 93, "CO", i = 94, "CP", _
i = 95, "CQ", i = 96, "CR", i = 97, "CS", i = 98, "CT", i = 99, "CU", i = 100, "CV", _
i = 101, "CW", i = 102, "CX", i = 103, "CY")
Sheets.Add
ActiveSheet.Select
Range("A1").Select
ActiveCell.formula = "='[Casos_Cerrados_Dic_2009.xls]JUL-AGO'!$" & letra & "2"
NuevaHoja = ActiveCell.Value
ActiveSheet.Name = NuevaHoja
Sheets("0900001").Select
Cells.Select
Selection.Copy
Sheets(NuevaHoja).Select
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Call Limpiar(NuevaHoja)
Call LlenarEncuesta(NuevaHoja, i, opc)
Next
End Sub
Código:
Sub copiarSEPOCT()
Dim NuevaHoja As String
Dim row As String
Dim i As Integer, opc As Integer
opc = 5
For i = 3 To 55
'row = CStr(i) ' + 3)
'Row = "3"
Dim letra As String
letra = Switch(i = 3, "B", i = 4, "C", i = 5, "D", i = 6, "E", i = 7, "F", i = 8, "G", _
i = 9, "H", i = 10, "I", i = 11, "J", i = 12, "K", i = 13, "L", i = 14, "M", i = 15, "N", _
i = 16, "O", i = 17, "P", i = 18, "Q", i = 19, "R", i = 20, "S", i = 21, "T", i = 22, "U", i = 23, _
"V", i = 24, "W", i = 25, "X", i = 26, "Y", i = 27, "Z", i = 28, "AA", i = 29, "AB", i = 30, "AC", _
i = 31, "AD", i = 32, "AE", i = 33, "AF", i = 34, "AG", i = 35, "AH", i = 36, "AI", i = 37, "AJ", _
i = 38, "AK", i = 39, "AL", i = 40, "AM", i = 41, "AN", i = 42, "AO", i = 43, "AP", i = 44, "AQ", _
i = 45, "AR", i = 46, "AS", i = 47, "AT", i = 48, "AU", i = 49, "AV", i = 50, "AW", i = 51, "AX", _
i = 52, "AY", i = 53, "AZ", i = 54, "BA", i = 55, "BB")
Sheets.Add
ActiveSheet.Select
Range("A1").Select
ActiveCell.formula = "='[Casos_Cerrados_Dic_2009.xls]SEP-OCT'!$" & letra & "2"
NuevaHoja = ActiveCell.Value
ActiveSheet.Name = NuevaHoja
Sheets("0900001").Select
Cells.Select
Selection.Copy
Sheets(NuevaHoja).Select
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Call Limpiar(NuevaHoja)
Call LlenarEncuesta(NuevaHoja, i, opc)
Next
End Sub
Código:
Sub copiarNOVDIC()
Dim NuevaHoja As String
Dim row As String
Dim i As Integer, opc As Integer
opc = 6
For i = 3 To 20
'row = CStr(i) ' + 3)
'Row = "3"
Dim letra As String
letra = Switch(i = 3, "B", i = 4, "C", i = 5, "D", i = 6, "E", i = 7, "F", i = 8, "G", _
i = 9, "H", i = 10, "I", i = 11, "J", i = 12, "K", i = 13, "L", i = 14, "M", i = 15, "N", _
i = 16, "O", i = 17, "P", i = 18, "Q", i = 19, "R", i = 20, "S")
Sheets.Add
ActiveSheet.Select
Range("A1").Select
ActiveCell.formula = "='[Casos_Cerrados_Dic_2009.xls]NOV-DIC'!$" & letra & "2"
NuevaHoja = ActiveCell.Value
ActiveSheet.Name = NuevaHoja
Sheets("0900001").Select
Cells.Select
Selection.Copy
Sheets(NuevaHoja).Select
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Call Limpiar(NuevaHoja)
Call LlenarEncuesta(NuevaHoja, i, opc)
Next
End Sub