Macro Genera dos columnas de todo un libro

[exekyel2010]

El usuario Antoni, me creo una macro el año pasado que funcionaba para generar las dos columnas (código y precio) de todo el libro.

intento configurar para este nuevo libro, y no logro que funcione.

Aclaro que funciono con los tres libros anteriores a este ultimo.

El libro original tiene 17 hojas, adjunto una muestra de 5 Hojas.

 

Espero su ayuda!

 

Gracias

 

Lista100.xls

[exekyel2010]

Lo solucione con el siguiente código:

Sub MacroPH_CodPre()
Application.ScreenUpdating = False
Hoja18.Cells.ClearContents
Hoja18.Range("A1") = "Código"
Hoja18.Range("B1") = "Precio"

Proceso Sheets("Hoja1"), "A", 1, 1
Proceso Sheets("Hoja1"), "D", 1, 1
Proceso Sheets("Hoja1"), "G", 1, 1
Proceso Sheets("Hoja1"), "J", 1, 1

Proceso Sheets("Hoja2"), "A", 1, 1
Proceso Sheets("Hoja2"), "D", 1, 1
Proceso Sheets("Hoja2"), "G", 1, 1
Proceso Sheets("Hoja2"), "J", 1, 1

Proceso Sheets("Hoja3"), "A", 1, 1
Proceso Sheets("Hoja3"), "D", 1, 1
Proceso Sheets("Hoja3"), "G", 1, 1
Proceso Sheets("Hoja3"), "J", 1, 1

Proceso Sheets("Hoja4"), "A", 1, 1
Proceso Sheets("Hoja4"), "D", 1, 1
Proceso Sheets("Hoja4"), "G", 1, 1
Proceso Sheets("Hoja4"), "J", 1, 1

Proceso Sheets("Hoja5"), "A", 1, 1
Proceso Sheets("Hoja5"), "D", 1, 1
Proceso Sheets("Hoja5"), "G", 1, 1
Proceso Sheets("Hoja5"), "J", 1, 1

Proceso Sheets("Hoja6"), "A", 1, 1
Proceso Sheets("Hoja6"), "D", 1, 1
Proceso Sheets("Hoja6"), "G", 1, 1
Proceso Sheets("Hoja6"), "J", 1, 1

Proceso Sheets("Hoja7"), "A", 1, 1
Proceso Sheets("Hoja7"), "D", 1, 1
Proceso Sheets("Hoja7"), "G", 1, 1
Proceso Sheets("Hoja7"), "J", 1, 1

Proceso Sheets("Hoja8"), "A", 1, 1
Proceso Sheets("Hoja8"), "D", 1, 1
Proceso Sheets("Hoja8"), "G", 1, 1
Proceso Sheets("Hoja8"), "J", 1, 1

Proceso Sheets("Hoja9"), "A", 1, 1
Proceso Sheets("Hoja9"), "D", 1, 1
Proceso Sheets("Hoja9"), "G", 1, 1
Proceso Sheets("Hoja9"), "J", 1, 1

Proceso Sheets("Hoja10"), "A", 1, 1
Proceso Sheets("Hoja10"), "D", 1, 1
Proceso Sheets("Hoja10"), "G", 1, 1
Proceso Sheets("Hoja10"), "J", 1, 1

Proceso Sheets("Hoja11"), "A", 1, 1
Proceso Sheets("Hoja11"), "D", 1, 1
Proceso Sheets("Hoja11"), "G", 1, 1
Proceso Sheets("Hoja11"), "J", 1, 1

Proceso Sheets("Hoja12"), "A", 1, 1
Proceso Sheets("Hoja12"), "D", 1, 1
Proceso Sheets("Hoja12"), "G", 1, 1
Proceso Sheets("Hoja12"), "J", 1, 1

Proceso Sheets("Hoja13"), "A", 1, 1
Proceso Sheets("Hoja13"), "D", 1, 1
Proceso Sheets("Hoja13"), "G", 1, 1
Proceso Sheets("Hoja13"), "J", 1, 1

Proceso Sheets("Hoja14"), "A", 1, 1
Proceso Sheets("Hoja14"), "D", 1, 1
Proceso Sheets("Hoja14"), "G", 1, 1
Proceso Sheets("Hoja14"), "J", 1, 1

Proceso Sheets("Hoja15"), "A", 1, 1
Proceso Sheets("Hoja15"), "D", 1, 1
Proceso Sheets("Hoja15"), "G", 1, 1
Proceso Sheets("Hoja15"), "J", 1, 1

Proceso Sheets("Hoja16"), "A", 1, 1
Proceso Sheets("Hoja16"), "D", 1, 1
Proceso Sheets("Hoja16"), "G", 1, 1
Proceso Sheets("Hoja16"), "J", 1, 1

Proceso Sheets("Hoja17"), "A", 1, 1
Proceso Sheets("Hoja17"), "A", 1, 1
Proceso Sheets("Hoja17"), "A", 1, 1
Proceso Sheets("Hoja17"), "A", 1, 1






End Sub

Private Sub Proceso(Hoja As Worksheet, Columna As String, Fila As Long, Precios As Integer)
Dim FilaPrecios As Long, x As Long, y As Integer
With Hoja
   For x = Fila To .Range(Columna & Rows.Count).End(xlUp).Row
      For y = 1 To Precios
         If Not .Cells(x, Columna).Offset(, y) = "" And _
            Not .Cells(x, Columna) = "" Then
            FilaPrecios = Hoja18.Range("A" & Rows.Count).End(xlUp).Row + 1
            Hoja18.Range("A" & FilaPrecios) = .Cells(x, Columna)
            Hoja18.Range("B" & FilaPrecios) = .Cells(x, Columna).Offset(, y)
         End If
      Next
   Next
End With
Hoja18.Select
End Sub

 

[Gerson Pineda]

Hace 1 hora, exekyel2010 dijo:

Sub MacroPH_CodPre() Application.ScreenUpdating = False Hoja18.Cells.ClearContents Hoja18.Range("A1") = "Código" Hoja18.Range("B1") = "Precio" Proceso Sheets("Hoja1"), "A", 1, 1 Proceso Sheets("Hoja1"), "D", 1, 1 Proceso Sheets("Hoja1"), "G", 1, 1 Proceso Sheets("Hoja1"), "J", 1, 1 Proceso Sheets("Hoja2"), "A", 1, 1 Proceso Sheets("Hoja2"), "D", 1, 1 Proceso Sheets("Hoja2"), "G", 1, 1 Proceso Sheets("Hoja2"), "J", 1, 1 Proceso Sheets("Hoja3"), "A", 1, 1 Proceso Sheets("Hoja3"), "D", 1, 1 Proceso Sheets("Hoja3"), "G", 1, 1 Proceso Sheets("Hoja3"), "J", 1, 1 Proceso Sheets("Hoja4"), "A", 1, 1 Proceso Sheets("Hoja4"), "D", 1, 1 Proceso Sheets("Hoja4"), "G", 1, 1 Proceso Sheets("Hoja4"), "J", 1, 1 Proceso Sheets("Hoja5"), "A", 1, 1 Proceso Sheets("Hoja5"), "D", 1, 1 Proceso Sheets("Hoja5"), "G", 1, 1 Proceso Sheets("Hoja5"), "J", 1, 1 Proceso Sheets("Hoja6"), "A", 1, 1 Proceso Sheets("Hoja6"), "D", 1, 1 Proceso Sheets("Hoja6"), "G", 1, 1 Proceso Sheets("Hoja6"), "J", 1, 1 Proceso Sheets("Hoja7"), "A", 1, 1 Proceso Sheets("Hoja7"), "D", 1, 1 Proceso Sheets("Hoja7"), "G", 1, 1 Proceso Sheets("Hoja7"), "J", 1, 1 Proceso Sheets("Hoja8"), "A", 1, 1 Proceso Sheets("Hoja8"), "D", 1, 1 Proceso Sheets("Hoja8"), "G", 1, 1 Proceso Sheets("Hoja8"), "J", 1, 1 Proceso Sheets("Hoja9"), "A", 1, 1 Proceso Sheets("Hoja9"), "D", 1, 1 Proceso Sheets("Hoja9"), "G", 1, 1 Proceso Sheets("Hoja9"), "J", 1, 1 Proceso Sheets("Hoja10"), "A", 1, 1 Proceso Sheets("Hoja10"), "D", 1, 1 Proceso Sheets("Hoja10"), "G", 1, 1 Proceso Sheets("Hoja10"), "J", 1, 1 Proceso Sheets("Hoja11"), "A", 1, 1 Proceso Sheets("Hoja11"), "D", 1, 1 Proceso Sheets("Hoja11"), "G", 1, 1 Proceso Sheets("Hoja11"), "J", 1, 1 Proceso Sheets("Hoja12"), "A", 1, 1 Proceso Sheets("Hoja12"), "D", 1, 1 Proceso Sheets("Hoja12"), "G", 1, 1 Proceso Sheets("Hoja12"), "J", 1, 1 Proceso Sheets("Hoja13"), "A", 1, 1 Proceso Sheets("Hoja13"), "D", 1, 1 Proceso Sheets("Hoja13"), "G", 1, 1 Proceso Sheets("Hoja13"), "J", 1, 1 Proceso Sheets("Hoja14"), "A", 1, 1 Proceso Sheets("Hoja14"), "D", 1, 1 Proceso Sheets("Hoja14"), "G", 1, 1 Proceso Sheets("Hoja14"), "J", 1, 1 Proceso Sheets("Hoja15"), "A", 1, 1 Proceso Sheets("Hoja15"), "D", 1, 1 Proceso Sheets("Hoja15"), "G", 1, 1 Proceso Sheets("Hoja15"), "J", 1, 1 Proceso Sheets("Hoja16"), "A", 1, 1 Proceso Sheets("Hoja16"), "D", 1, 1 Proceso Sheets("Hoja16"), "G", 1, 1 Proceso Sheets("Hoja16"), "J", 1, 1 Proceso Sheets("Hoja17"), "A", 1, 1 Proceso Sheets("Hoja17"), "A", 1, 1 Proceso Sheets("Hoja17"), "A", 1, 1 Proceso Sheets("Hoja17"), "A", 1, 1 End Sub

... y para que no se vea ese "horror"  , puedes probar con:

Sub MacroPH_CodPre()

Application.ScreenUpdating = False

Hoja18.Cells.ClearContents
Hoja18.Range("A1") = "Código"
Hoja18.Range("B1") = "Precio"

For Each hoja In Worksheets
    Proceso Sheets(hoja.Name), "A", 1, 1
    Proceso Sheets(hoja.Name), "D", 1, 1
    Proceso Sheets(hoja.Name), "G", 1, 1
    Proceso Sheets(hoja.Name), "J", 1, 1
Next

Application.ScreenUpdating = True

End Sub

 

Saludos