UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo

No se puede subir archivos al foro, favor de hacerlo en servidor externo (Dropbox, Drive...) y dejan link. "Sin archivo no hay respuestas"

Favor de leer "Todos los temas" Click aquí.

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

JosaphatDiaz


Hola que tal, buen dia!

Necesito ayuda ustedes los expertos, Quisiera abrir varios archivos en diferentes folders..

Por ejemplo.. tengo 50 carpetas en cada uno.. tengo un excel.... quisiera abrir los 50 archivos excel con una macros..

Es posible??

Igtelo

avatar
Hola Josaphat.

Claro que se puede, Pero... Piensa bien lo que quieres hacer.

Te pregunto: ¿Que vas a hacer con 50 libros abiertos? son un demonial.
Razona tu planteamiento y el resultado al que "necesitas" llegar, tu pregunta engloba muchas acciones para lo que realmente "necesitas".

No hagas preguntas a la ligera y para apoyarte tienes que mostrar algún avance de tu desarrollo que ya hayas hecho, que muestres algo de tu esfuerzo, hacerles todo ya no.

Saludos
Ignacio Téllez

3 RE: el 28/06/18, 04:54 pm

JosaphatDiaz


Hola que tal Ignacio!

Antes de que nada muchas gracias por tu pronta respuesta.... es la primera vez que me inscribo en un blog..

Originalmente me pidieron realizar una macros para analizar 50 muestras de un producto en Test Benches, lo cual ya termine el proyecto y se ha compilado existosamente.. lamentablemente me acaban de informar.. que los archivos en excel como me habian comentado que se iban a encontrar(INPUT).. no es correcto.. me comentan que el banco entrega un folder con dos foler un .xml y el excel.. en donde estan todos los datos...

Es por eso que requiero de su expertisse para ver la manera de modificar el codigo... he buscado por todas partes.. y he tratado de hacer varios codigos.. pero aun sin exito..

Envio el codigo del programa...

Sub Macro_VTS()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim SelectedFiles() As Variant
    Dim NRow As Long
    Dim NCol As Long
    Dim filename As String
    Dim NFile As Long
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range
    Dim VTS_Template As Workbook
    Dim NewTemplate As Variant
    Dim DestSampleID As Range
    Dim SourceSampleID As Range
    Dim TypeofTemp As Long
    Dim TypeofPress As Long
   
   
  Application.ScreenUpdating = False

'____________________________________________________________________________________________________________'

  'Message Box of initial work'
     MsgBox "Newton welcomes you, please select the files to work with", vbInformation, "Hello!"
         
     ' Open the file dialog box and filter on Excel files, allowing multiple files
' to be selected.
SelectedFiles = Application.GetOpenFilename( _
   filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)
    
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1
NCol = 5
'__________________________________________________________________________________________________'

''------ *Open the XX Template*-----------
       
Set VTS_Template = Workbooks.Open("\XXXXXXXXXXTemplate.xlsx")
       
' Loop through the list of returned file names
For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
' Set FileName to be the current workbook file name to open.
filename = SelectedFiles(NFile)
Set WorkBk = Workbooks.Open(filename)

        ''------ *P-I Curve Rising Current Extract data, Range("A1:K24")*-----------
       
        Sheets("Curves").Select
        Range("A1:K24").Select
        Application.CutCopyMode = False
        Selection.Copy
       
            ' Create a new workbook and set a variable to the first sheet.
        Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
        Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
        ''------ *P-I Curve Falling Current Extract data, Range("A2501:K2524")*-----------
           
        WorkBk.Activate
        Sheets("Curves").Select
        Range("A2501:K2524").Select
        Application.CutCopyMode = False
        Selection.Copy
        SummarySheet.Activate
        Range("A26").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
         ''------ *Leakage Rising  Current Extract data, Range("A10001:K10024")*-----------
        
        WorkBk.Activate
        Sheets("Curves").Select
        Range("A10001:K10024").Select
        Application.CutCopyMode = False
        Selection.Copy
        SummarySheet.Activate
        Range("A51").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
        ''------ *Leakage Falling  Current Extract data, Range("A12501:K12524")*-----------
       
        WorkBk.Activate
        Sheets("Curves").Select
        Range("A12501:K12524").Select
        Application.CutCopyMode = False
        Selection.Copy
        SummarySheet.Activate
        Range("A76").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
               ''------ *Hysteresis ,Extract data_ Range("A12501:K12524")*-----------
              
        WorkBk.Activate
        Sheets("Curves").Select
        Range("A17501:K17524").Select
        Application.CutCopyMode = False
        Selection.Copy
        SummarySheet.Activate
        Range("A101").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
        ''------ *IDSample ,Extract data_ Range("B24")*-----------
              
        WorkBk.Activate
        Sheets("Info").Select
        Range("B24").Select
        Application.CutCopyMode = False
        Selection.Copy
        SummarySheet.Activate
        Range("N1").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

                  ''------ *Calculate Average of each Measure Range*-----------

        Range("M4").Select
        ActiveCell.FormulaR1C1 = "=AVERAGE(RC[-11]:RC[-2])"
        Range("M4").Select
        Selection.AutoFill Destination:=Range("M4:M124"), Type:=xlFillDefault
        Range("M4:M124").Select
        Range("O116").Select
       
           ''------ *Calculate Offset  of Leakage Measure Range*-----------
          
        Range("N54").Select
        ActiveCell.FormulaR1C1 = "=(AVERAGE(RC[-12]:RC[-3]))-12"
        Range("N54").Select
        Selection.AutoFill Destination:=Range("N54:N99"), Type:=xlFillDefault
        Range("A54:N99").Select
       
        ''------ *Calculate Repeteability of each P-I Curve Measure Range*-----------
       
        Range("O4").Select
        ActiveCell.FormulaR1C1 = "=MAX(RC[-13]:RC[-4])-MIN(RC[-13]:RC[-4])"
        Range("O4").Select
        Selection.AutoFill Destination:=Range("O4:O49"), Type:=xlFillDefault
        Range("O4:O49").Select

        ''------ *Close the source workbook without saving changes.*-----------

        WorkBk.Close Savechanges:=False
       
        ''------ * Open the current workbook'*-----------
       
        SummarySheet.Activate

        ''------ * Set the source of number sample'*----------
       
        Set SourceRange = SummarySheet.Cells(1, 14)
     
       
       ''------ * Set the Dest of number sample'*----------
       
         Set DestRange = XXX_Template.Worksheets("Data").Cells(7, NCol)
       
         Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
         SourceRange.Columns.Count)
       
        ''------ * Copy over the value of the Number Sample Source to Destination'*----------
       
        DestRange.Value = SourceRange.Value
       
     
        
 '___________********PI Curve - Rising Current********PI Curve - Rising Current**********'
 
     
 '------ * Open the current workbook'*-----------
 
 SummarySheet.Activate

 ''------ * Set the source of number sample'*----------
 
 Set SourceRange = SummarySheet.Range("M4:M24")
 
''------ * Set the Dest of number sample'*----------
 
  Set DestRange = XXX_Template.Worksheets("Data").Cells(8, NCol)
  Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
  SourceRange.Columns.Count)
 
 ''------ * Copy over the value of the Number Sample Source to Destination'*----------
 
 DestRange.Value = SourceRange.Value

'___________********PI Curve - Falling Current********PI Curve - Falling Current********** '
 
     
 '------ * Open the current workbook'*-----------
 
 SummarySheet.Activate

 ''------ * Set the source of number sample'*----------
 
 Set SourceRange = SummarySheet.Range("M29:M49")
 
''------ * Set the Dest of number sample'*----------
 
  Set DestRange = XXX_Template.Worksheets("Data").Cells(32, NCol)
  Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
  SourceRange.Columns.Count)
 
 ''------ * Copy over the value of the Number Sample Source to Destination'*----------
 
 DestRange.Value = SourceRange.Value
 
 
 '___________********Hysteresis********Hysteresis********** ___________'
 
     
 '------ * Open the current workbook'*-----------
 
 SummarySheet.Activate

 ''------ * Set the source of number sample'*----------
 
 Set SourceRange = SummarySheet.Range("M104:M124")
 
''------ * Set the Dest of number sample'*----------
 
  Set DestRange = XXX_Template.Worksheets("Data").Cells(56, NCol)
  Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
  SourceRange.Columns.Count)
 
 ''------ * Copy over the value of the Number Sample Source to Destination'*----------
 
 DestRange.Value = SourceRange.Value
 
 
 '___________********Leakage Rising Current********Leakage Rising Current**********'
 
     
 '------ * Open the current workbook'*-----------
 
 SummarySheet.Activate

 ''------ * Set the source of number sample'*----------
 
 Set SourceRange = SummarySheet.Range("N54:N74")
 
''------ * Set the Dest of number sample'*----------
 
  Set DestRange = XXX_Template.Worksheets("Data").Cells(80, NCol)
  Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
  SourceRange.Columns.Count)
 
 ''------ * Copy over the value of the Number Sample Source to Destination'*----------
 
 DestRange.Value = SourceRange.Value
 
 
  '___________********Leakage Falling Current********Leakage Falling Current**********'
 
     
 '------ * Open the current workbook'*-----------
 
 SummarySheet.Activate

 ''------ * Set the source of number sample'*----------
 
 Set SourceRange = SummarySheet.Range("N79:N99")
 
''------ * Set the Dest of number sample'*----------
 
  Set DestRange = XXX_Template.Worksheets("Data").Cells(104, NCol)
  Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
  SourceRange.Columns.Count)
 
 ''------ * Copy over the value of the Number Sample Source to Destination'*----------
 
 DestRange.Value = SourceRange.Value
 
 
 '___________********Repeteability Rising Current********Repeteability Rising Current**********'
 
     
 '------ * Open the current workbook'*-----------
 
 SummarySheet.Activate

 ''------ * Set the source of number sample'*----------
 
 Set SourceRange = SummarySheet.Range("O4:O24")
 
''------ * Set the Dest of number sample'*----------
 
  Set DestRange = XXX_Template.Worksheets("Data").Cells(128, NCol)
  Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
  SourceRange.Columns.Count)
 
 ''------ * Copy over the value of the Number Sample Source to Destination'*----------
 
 DestRange.Value = SourceRange.Value
 
 
 '___________********Repeteability Falling Current********Repeteability Falling Current**********'
 
     
 '------ * Open the current workbook'*-----------
 
 SummarySheet.Activate

 ''------ * Set the source of number sample'*----------
 
 Set SourceRange = SummarySheet.Range("O29:O49")
 
''------ * Set the Dest of number sample'*----------
 
  Set DestRange = VTS_Template.Worksheets("Data").Cells(152, NCol)
  Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
  SourceRange.Columns.Count)
 
 ''------ * Copy over the value of the Number Sample Source to Destination'*----------
 
 DestRange.Value = SourceRange.Value

        
   ''------ * Increase NRow so that we know where to copy data next.*----------
 
 NCol = NCol + DestRange.Columns.Count

   ''------ * Clean and Close SummarySheet.*----------
  
    SummarySheet.Activate
    Rows.ClearContents
    ActiveWindow.Close Savechanges:=False
       
            Next NFile
               
     '__________________________________________________________________'
    
     '------ * Copy Type XXX, Temperature, Pressure *----------
    
     Windows("Newton.xlsm").Activate
     Set SourceRange = ThisWorkbook.Worksheets("Sheet1").Range("F2:F4")
    Set DestRange = XXX_Template.Worksheets("Data").Range("F2:F4")
     DestRange.Value = SourceRange.Value
                 
     ''------ * Clean Newton worksheet.*----------
  
    Windows("Newton.xlsm").Activate
    Rows.ClearContents
   
       
    'Message Box of finalized work'
     MsgBox " Newton has successfully performed the analysis, please Save As the new template ", vbInformation, "Done!"

    'Save the new Template'
     Windows("XXX_Template.xlsx").Activate
     NewTemplate = ActiveWorkbook.Application.GetSaveAsFilename(NewTemplate, filefilter:="Text files (*.xlsx), *.xlsx")
     ActiveWorkbook.SaveAs NewTemplate, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    '
    Range("F3").Select
    Selection.NumberFormat = "0"
    Range("F4").Select
    Selection.NumberFormat = "0"
             
  Windows("Newton.xlsm").Activate
ActiveWindow.Close Savechanges:=False
Application.ScreenUpdating = True


End Sub

Igtelo

avatar
Josaphat.

Te repito: ¿A qué resultado necesitas llegar? Hablas mucho y dices "nada".
Sube un excel donde muestres: Esto tengo y requiero esto.

No voy a analizar tu código ni voy a crear tus archivos. Lee las normas del foro y el anuncio en rojo al inicio de todas las páginas del foro.

Ignacio Téllez

5 RE: el 29/06/18, 01:28 pm

JosaphatDiaz


Buen dia a todos!

Actualmente ya logre realizar mi codigo para un folder.. estoy buscando la manera de lograrlo para todos los folders a seleccionar.
Adjunto el excel..
Espero alguien me pueda auxiliar.

Contenido patrocinado


Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.