Met inputbox een gedeelte van code vervangen in een macro

[jevers]

Voor dataverwerking heb ik een macro geschreven die 50x een bestand opent daar een bepaalde selectie uit kopieert en die allemaal naast elkaar in 1 werkblad plakt. Het is wellicht niet de meest compacte of efficiëntste code, maar hij werkt.

Nu is het zo gemaakt dat ik zelf in de macro 2 termen moet vervangen (met Crtl H) voordat ik de macro kan gebruiken om een set nieuwe data te werken: namelijk de naam van de map waar de desbetreffende 50 bestanden in staan en de bestandsnaam zelf. (de eerste term komt 51 keer voor en de twee term komt 151 keer voor in de macro)

Graag zou ik deze macro ook door anderen laten gebruiken, echter vroeg ik me af of het dan mogelijk is dat er met een soort van input box gevraagd wordt om deze twee gegevens en dat deze dan automatisch in de macro vervangen worden.
Of moet ik dan werken met 2 macro's die elkaar aanroepen?

Hopelijk kan iemand me vooruit helpen!
Groeten, Jeanette

 

[Roncancio]

Indien je alle bestanden in een bepaalde directory wilt gebruiken, dan kan je dmv een lus elk bestand aanroepen. Je hoeft dan niet steeds de naam van het bestand in te vullen.

Wat je daarbij ook kunt doen is dmv GetOpenFilename de gebruiker de betreffende directory laten zoeken.

Met vriendelijke groet,


Roncancio

 

[jevers]

Beste Roncancio,

Bedankt voor je antwoord.
Het is me gelukt om met GetOpenFilename de goede directory te vinden. Maar hoe kun je het dan voor elkaar krijgen dat hij van elke file een bepaalde range kopieert en in het goede werkblad plakt, en dan automatisch het volgende bestand in die directory pakt?

Hieronder een gedeelte van de code, wellicht geeft dit meer inzicht in hoe de macro in elkaar zit.

Sub Verwerkdata()
 
  Application.ScreenUpdating = False
   
   
 
 Sheets("blad3").Select
         F = Dir("C:\Users\Fluorescence data\11-07-2011\t2*.xlsx")
         Do While Len(F) > 0
               ActiveCell.Formula = F
               ActiveCell.Offset(1, 0).Select
               F = Dir()
          Loop
    Range("a1").Select
          
 Range("a1:a50").Select
 Selection.Sort Key1:=Range("A1"), Order1:=xlAscending
       
  'controleer testdatanummer
    
    If ActiveCell.Value = "" Then GoTo klaar
    If ActiveCell.Value = "t2#01.xlsx" Then
    Workbooks.Open Filename:="C:\Users\Fluorescence data\11-07-2011\t2#01.xlsx"
    Range("b55:b456").Select
    Selection.Copy
    Workbooks("Verwerk Fluorescence data.xls").Activate
    Sheets("data").Select
    Range("b2").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "1"
    Workbooks("t2#01.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWindow.Close
    Workbooks("Verwerk Fluorescence data.xls").Activate
    Sheets("blad3").Select
    Range("A1").Select
    Selection.Delete Shift:=xlUp
    Range("a1").Select
    End If
    
    If ActiveCell.Value = "" Then GoTo klaar
    If ActiveCell.Value = "t2#02.xlsx" Then
    Workbooks.Open Filename:="C:\Users\Fluorescence data\11-07-2011\t2#02.xlsx"
    Range("b55:b456").Select
    Selection.Copy
    Workbooks("Verwerk Fluorescence data.xls").Activate
    Sheets("data").Select
    ActiveCell.Offset(1, 1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "2"
    Workbooks("t2#02.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWindow.Close
    Workbooks("Verwerk Fluorescence data.xls").Activate
    Sheets("blad3").Select
    Range("A1").Select
    Selection.Delete Shift:=xlUp
    Range("a1").Select
    End If

klaar:
    Sheets("data").Select
    Range("b2").Select
    
     Application.ScreenUpdating = True
   
   MsgBox "data zijn verwerkt"
      End Sub

 

[Roncancio]

Met onderstaande code kan je de directory zoeken waar de bestanden in staan.
Vervolgens kies je een Excelbestand (er wordt gezocht naar bestanden met de extensie xlsx).
Zodra je op OK klikt, wordt elk Excelbestand in die directory geopend en de gegevens naar het werkblad Data van je bestand gekopieerd.

De namen van de bestanden verschijnen in de 1e rij.
De gegevens van elk bestand staat eronder (vanaf rij 2).

Dim strFile As String
Dim colFiles As New Collection
Dim iTel As Integer
    
    B = Application.GetOpenFilename("Excel bestanden (*.xlsx), *.xlsx")
    If Not B = False Then
        strFile = Dir(Left(B, InStrRev(B, "\")) & "*.xlsx")
        
        While strFile <> ""
            colFiles.Add strFile
            strFile = Dir
        Wend
    
        If colFiles.Count > 0 Then
            For iTel = 1 To colFiles.Count
                Workbooks.Open colFiles(iTel)
                ThisWorkbook.Worksheets("Data").Cells(1, iTel) = colFiles(iTel)
                Workbooks(Workbooks.Count).Worksheets(1).Range("b55:b456").Copy ThisWorkbook.Worksheets("Data").Cells(2, iTel)
                Workbooks(Workbooks.Count).Close SaveChanges:=vbFalse
            Next
        End If
    End If

Met vriendelijke groet,


Roncancio

 

[jevers]

Beste Roncancio,

Bedankt voor je hulp, deze code doet inderdaad precies wat ik wil en is een stuk eenvoudiger dan die ik had!

Groeten, Jeanette