Pasar datos de diferentes hojas a un libro nuevo

[macdanmx]

Team,

Un favor, me podrían ayudar asesorandome para mejorar una macro, en esta lo que he tratado de hacer es que me pase datos de varias hoja a una sola.

1.- La macro del archivo DatosDiscos.xlsm me importa archivos de TXT y me genera un libro nuevo que en este caso se llama ResultadoDatosDiscos.xlsm, por cada TXT hay una hoja con sus respectivos datos, misma estructura todos. Cada TXT correponde a un día de un determinado mes, en este caso solo adjunte 11, pero como puedo tener 30 o 31.

2.- La macro con la que quero que me ayuden es la que esta dentro de la hoja DatosDisco1 del libro ResultadoDatosDiscos.xlsm, esta macro lo que hace es copiarme por cada hoja, los datos de la columna "B" los cuales corresponden al DISCO1, pero como tengo que repetir este mismo proceso 5 veces uno por disco, quisierá optimizar el código para que de un solo click, me genere en en ya sea en el mismo libro o en uno nuevo los datos que necesito por DISCO.

Tengo algo así.

Sub SeparaDatosDiscos()


Application.ScreenUpdating = False

Dim hojas As Integer

hojas = Application.Worksheets.Count

For a = 1 To hojas

Sheets(a).Select

If ActiveSheet.Name = "Disco1" Then GoTo line1

ActiveSheet.Unprotect

[B2:B290].Select

Selection.Copy

Sheets("Disco1").Select

'desplazamiento a la izquierda

[IV1].Select

Selection.End(xlToLeft).Select

If ActiveCell <> "" Then ActiveCell.Offset(, 1).Select

ActiveCell = Sheets(a).Name

ActiveCell.Offset(1, 0).Select

ActiveSheet.Paste

line1:

Next a

For b = 1 To hojas

Sheets(.Select

If ActiveSheet.Name = "Disco1" Then GoTo line2

ActiveSheet.Unprotect

line2:

Next b

Sheets("Disco1").Select

[a1].Select

End Sub[/CODE]

Anexo envío el archivo .zip con los archivo como ejemplo.

Gracias.

[macdanmx]

compañeros,

Antes que nada una disculpa por no haber tomado en cuenta lo del envolver el código, supongo que por eso no se me había tomado en cuenta para resolver mi problema. Como quiera, agradezco el apoyo que me puedan proporcionar.

Estoy trabajando con un pequeño proyecto en el cual tengo que importar algunos archivos de texto y después consolidar datos de varias columnas en otras hojas, el código que les presento es parte de lo que tengo, pero como podría optimizarlo no sé, en lugar de dos macros solo fuera una, ya que lo tengo que repetir 5 veces el proceso de acuerdo con lo que yo he podido hacer...... anexo envío el archivo con los ejemplos y algunos detalles.

Archivo DatosDiscos.xlsm

1. Importa varios archivos de texto a un libro de Excel

2. Cada archivo corresponde a un día de un mes

3. Cada archivo corresponde una hoja del libro de Excel

4. El nombre de las hojas corresponder con el nombre del archivo sin la extensión

Nota: La macro que me han ayudado a crear me trae el nombre completo con todo y extensión. No quiero la extensión.

Sub SeparaDatosDiscos()


Application.ScreenUpdating = False

 Dim hojas As Integer

 hojas = Application.Worksheets.Count

 For a = 1 To hojas

 Sheets(a).Select

 If ActiveSheet.Name = "Disco1" Then GoTo line1

 ActiveSheet.Unprotect

 [B2:B290].Select

 Selection.Copy

 Sheets("Disco1").Select

 'desplazamiento a la izquierda

 [IV1].Select

 Selection.End(xlToLeft).Select

 If ActiveCell <> "" Then ActiveCell.Offset(, 1).Select

 ActiveCell = Sheets(a).Name

 ActiveCell.Offset(1, 0).Select

 ActiveSheet.Paste

 line1:

 Next a

 For b = 1 To hojas

 Sheets(.Select

 If ActiveSheet.Name = "Disco1" Then GoTo line2

 ActiveSheet.Unprotect

 line2:

 Next b

 Sheets("Disco1").Select

 [a1].Select

 End Sub

[/CODE]

[CODE]
Sub SeparaDatosDiscos()

Application.ScreenUpdating = False
Dim hojas As Integer
hojas = Application.Worksheets.Count
For a = 1 To hojas
Sheets(a).Select
If ActiveSheet.Name = "Disco1" Then GoTo line1
ActiveSheet.Unprotect
[B2:B290].Select
Selection.Copy
Sheets("Disco1").Select
'desplazamiento a la izquierda
[IV1].Select
Selection.End(xlToLeft).Select
If ActiveCell <> "" Then ActiveCell.Offset(, 1).Select
ActiveCell = Sheets(a).Name
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
line1:
Next a
For b = 1 To hojas
Sheets(.Select
If ActiveSheet.Name = "Disco1" Then GoTo line2
ActiveSheet.Unprotect
line2:
Next b
Sheets("Disco1").Select
[a1].Select
End Sub
[/CODE]

PruebaDatosDiscos.zip