Samle data fra mange filer - til et samle-ark, via makro eller lign!

Er de 100 filer helt ens mht. opstillingen af data ?

Ja, det er de.

Piv piv... er der slet ingen hjælp at hente på denne forespørgsel?

Arbejder på det...
Mvh finb

har en makro der sortere og fjerner dubletter, den har ikke noget kriterier om f.eks. nyeste eller størst salg
men den kan måske inspirere eller hjælpe
mvh Lars


Sub SortereKontrakter()
' sortere kontrakterne på fanen 'kontrakter' og fjerner dubletter
' kaldes fra makroen OpdatereKontrakter

    Sheets("kontrakter").Select
    Range("A1").Select
    ActiveWorkbook.Worksheets("kontrakter").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("kontrakter").AutoFilter.Sort.SortFields.Add Key:= _
        Range("A4:A500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("kontrakter").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A$1:$L$500").RemoveDuplicates Columns:=1, Header:=xlYes
    Sheets("MENU").Select
    Range("A1").Select
End Sub

har du makroen til at hente fra de forskellige regneark ?
/LA

#L_Amtoft
Tak - men jeg har absolut ingen forstand på makroer, så jeg kan desværre ikke selv arbejde videre på den. Men ellers tak.

#finb
Det lyder lækkert, jeg glæder mig allerede - og tak.

Dette er ikke kønt, men det virker.
Opret en master-fil i Excel, tast ALT+F11, og indsæt nedenstående makro.
Jeg har tilrettet Ransborgs makro, giv ham pointene:

Option Explicit
Sub GetAllData()

Dim FS As FileSearch
Dim FilePath As String
Dim FileSpec As String
Dim i As Long
'Dim v As Variant
Dim rTarget As Range
Dim ToSheet As Worksheet
Dim Data As Variant
Dim Salgstal_max_vaerdier As Range
Dim SalgsTalAktuelFil As Range
Dim Celle_i_salgstal_max_vaerdier
Dim Celle_i_salgsTalAktuelFil
'Dim AktueltSalgstal_i_AktuelFil As Single
'dim array-master:
Dim Salgstal_Master() As Single
Dim M As Integer
M = 1
ReDim Salgstal_Master(M)
Dim VisM As Integer

'FilePath = Den sti, hvor dine 100 filer ligger, fx:
FilePath = "C:\WINDOWS\Desktop\Excel-filer\ ...osv...

'FileSpec = Det navnemønster, dine 100 filer har, fx:
'"MangeFiler_001.xls" , "MangeFiler_002.xls" , osv... , bliver
'til søgemasken:

FileSpec = " MangeFiler_*.xls"

Set ToSheet = Workbooks("Saml_mange_ark_MASTER").Worksheets("AlleMaxVaerdier") ''ThisWorkbook.Worksheets("AlleMaxVaerdier") ''Workbooks("Saml_mange_ark_MASTER").Worksheets("AlleMaxVaerdier") ''ThisWorkbook.Worksheets("AlleMaxVaerdier")
Set Salgstal_max_vaerdier = ToSheet.Range("N6:N35")
Salgstal_max_vaerdier.Select
'MsgBox ""
Salgstal_max_vaerdier.Clear
'MsgBox ""
 
'Find nu Excel-filerne:

Set FS = Application.FileSearch
   
With FS
  .LookIn = FilePath
  .Filename = FileSpec
  .SearchSubFolders = False  'Søg ej underfoldere
  .Execute                    'If .FoundFiles.Count = 0 Then ' MsgBox ("Ingen filer fundet") ' Exit Sub ' End If
End With

'Hent data i aktuel fil:

For i = 1 To FS.FoundFiles.Count
  Workbooks.Open Filename:=FS.FoundFiles(i)
  Range("A1").Select
  MsgBox "Du står i denne fil:" & vbCrLf & FS.FoundFiles(i)
 
  Set SalgsTalAktuelFil = Range("N6:N35")
      SalgsTalAktuelFil.Select
      'MsgBox ""

  'Indledningsvis er alle data i ark 1 max-værdier; alle lægges over i master-filen:

  If i = 1 Then
    Set Data = Range("a3:n35")
    Data.Select
    Data.Copy
    ToSheet.Range("a3").PasteSpecial
    Application.CutCopyMode = False
    'MsgBox ""
  End If
 
  SalgsTalAktuelFil.Select

    Dim Salgstal() As Single
    Dim S As Integer
    S = 1
    ReDim Salgstal(S)
    Dim VisS As Integer

  For Each Celle_i_salgsTalAktuelFil In SalgsTalAktuelFil
    Celle_i_salgsTalAktuelFil.Select
       
      Salgstal(S) = Celle_i_salgsTalAktuelFil.Value
      S = S + 1
      ReDim Preserve Salgstal(S)
  Next Celle_i_salgsTalAktuelFil

    'MsgBox "Alm. salgstal er nu lagt i array"
        'For VisS = 1 To UBound(Salgstal) - 1
          'MsgBox VisS & ". høstede:" & vbCrLf & Salgstal(VisS)
          'Salgstal_max_vaerdier.Select ''Salgstal_max_vaerdier.Cells(S).Select
        'Next VisS

      MsgBox "filen lukkes"
  ActiveWorkbook.Close True                'ActiveWorkbook.Close False
      'MsgBox "filen lukkes"

      ToSheet.Activate ''' vis master-fil
      'MsgBox "Dette er Master-filen"
      Salgstal_max_vaerdier.Select
      'MsgBox "Master-filens salgstal"

' array master her:

      For Each Celle_i_salgstal_max_vaerdier In Salgstal_max_vaerdier
        Salgstal_Master(M) = Celle_i_salgstal_max_vaerdier
        M = M + 1
        ReDim Preserve Salgstal_Master(M)
      Next Celle_i_salgstal_max_vaerdier
     
      'MsgBox "Master-salgstal er lagt i array"
     
          VisM = 0 '''' TEST !!!!!!!!!!
      For VisM = 1 To 30 'UBound(Salgstal_M) - 1
        If Salgstal(VisM) > Salgstal_Master(VisM) Then
          'MsgBox VisM & ". række i begge filer:" & vbCrLf & _
                Salgstal(VisM) & " - i aktuel fil" & vbCrLf & _
                Salgstal_Master(VisM) & " i master-fil" & vbCrLf & _
                "fil-tal er større end master-tal, som nu ondannes t fil-tal"
          Salgstal_Master(VisM) = Salgstal(VisM)
     
      'Nu skrives det større tal fra alm. fil i master-filens salgstal-range:
         
          Salgstal_max_vaerdier.Cells(VisM).Select
          'MsgBox "se gl værdi i master-salgstal"
          Salgstal_max_vaerdier.Cells(VisM) = Salgstal(VisM)
          MsgBox " d nye større værdi er nu skrevet i masterRanget"
         
        End If
      Next VisM                  '"første master-tal: " & Salgstal_max_vaerdier.Cells(1).Value

Next ''Undersøg næste fil

End Sub

Overvej, om du fremover vil lægge alle filer i een fil, på hver sit ark.
Døb arkene "101030", "101031", 101101", osv., så du senere kan sortere arkene.
Filen bliver langsom og stor, til gengæld kan du konsolidere
NÅRSOMHELST og find min, max, gennemsnit, osv.

Mvh finb

Hej finb,

Jeg får desværre "Subscript out of range" når jeg afvikler makroen. Jeg benytter Excel2003, ved om om det gør nogen forskel?

Tast ALT+F11,
klik et tilfældigt sted i makroen.

Afspil: Hold tasten F8 (på tastaturet) inde, indtil makroen går i stå, og skriv tilbage hertil, hvor  i makroen, fejlen opstår.

mvh finb

Tak.
Den går i stå her:
Set ToSheet = Workbooks("Saml_mange_ark_MASTER").Worksheets("AlleMaxVaerdier") ''ThisWorkbook.Worksheets("AlleMaxVaerdier") ''Workbooks("Saml_mange_ark_MASTER").Worksheets("AlleMaxVaerdier")

Følgende:

Set ToSheet = Workbooks("Saml_mange_ark_MASTER").Worksheets("AlleMaxVaerdier")

virker, hvis din master-fil hedder:
"Saml_mange_ark_MASTER"

Ellers skal du erstatte "Saml_mange_ark_MASTER" med navnet på din master-fil.

OG:

Hele smøren:
Set ToSheet = Workbooks("Saml_mange_ark_MASTER").Worksheets("AlleMaxVaerdier")

-skal stå i samme linie i makroen.

OG:

dit master-regneark (eet ark) skal hedde:

"AlleMaxVaerdier"

-eller også skal du ændre makroens ark-navn "AlleMaxVaerdier" til det ark-navn, du selv bruger.

OG:
Sidst i dit indlæg #11:
Slet eksakt disse linier:

''ThisWorkbook.Worksheets("AlleMaxVaerdier")
''Workbooks("Saml_mange_ark_MASTER").Worksheets("AlleMaxVaerdier")

-og prøv igen...

Hej finb,

Den virker desværre ikke....

Når jeg har lavet dine ændringsforslag stopper fejlen, men det eneste der sker i master-filen, er at kolonne N6 - N35 bliver fremhævet, men der kommer ingen tal i arket.
Jeg har omdøbt master-filen til "Saml_mange_ark_MASTER" og omdøbt "sheet1" i master-filen til "AlleMaxVaerdier" og til sidst har jeg slettet de 2 linier du bad mig om!

Alle de filer jeg skal indsamle data fra, starter med "DOHA top 30" -og derefter et tal som ikke har noget mønster. I FileSpec har jeg derfor skrevet FileSpec = " DOHA_*.xls"

Mvh
living8671

Slet UNDERSCORE i:

FileSpec = " DOHA_*.xls"

så der i stedet står:

FileSpec = " DOHA*.xls"

-og klik et tilfældigt sted i makroen,
prøv at afspille makroen med tasten F5.

Hej finb,

Der sker det samme!

Mvh
Living8671

Har du i FilePath=
skrevet den nøjagtige sti, hvor din master-fil ligger ?

Du kan kopiere stien fra master-filen:

filer>>egenskaber>>generelt>>placering

Hej finb,

Stien i FilePath er god nok:
FilePath = "C:\Documents and Settings\Thom\Skrivebord\reservedel"

Har lagt mit master-ark her, så du evt. kan se hvordan makroen ser ud hos mig.

http://www.gratisupload.dk/download/51508/

Mvh
living8671

Gå ind på PeeCee.dk

Der har jeg lagt 4 filer, datafil 1 til 4
og en master-fil. De fungerer sammen.

Søg i uploads og skriv i
søgestrengen: saml_mange

Når du downloader de 4 filer, skal du lægge dem i samme mappe på din pc.

Mvh finb

Hej finb

Det virker desværre stadig ikke!
Jeg får adskellige run-time errors.
Modul 1: run-time error 1004
Modul 2: run-time error 438
Modul 2: run-time error 1004

Mvh
living8671

hej living

Slet modul 1.

Jeg kender ikke run-time-error,
spørg her på eksperten, om nogen kan hjælpe.

mvh finb

Send et svar og pointene er dine - nu virker "skidtet" :)

Lukker denne

Hej..

Jeg har netop forsøgt, at bruge denne kode, så jeg kan opsamle info fra flere regneark.

Jeg bruger Excel 2013 og her virker det som om, at funktionen  Application.FileSearch ikke længere virker.

Er der nogen der har et bud på, hvad jeg så skal bruge?

Hilsen fra Lars