Cod macro copiere si prelucrare date

Ce este nou in Microsoft Excel 2013?
Informatii despre cum se utilizeaza Microsoft Excel 2013
Calcule, Formule, Functii, Tabele pivot, Analiza datelor, etc
electros
Mesaje: 60
Membru din: Dum Iul 29, 2012 4:38 pm

Cod macro copiere si prelucrare date

Mesaj de electros » Mar Feb 02, 2021 7:37 pm

Buna seara.Revin cu o rugaminte la voi cei care ma puteti ajuta.
Se da fisierul atasat care are 3-4 foi cu date dar din care ma intereseaza doar foaia "Calcul" in care datele sunt aduse cu ajutorul unor formule. Acest fisier se afla in circa 500 de exemplare in maai multe subdosare care se gasesc toate in acelasi dosar pe un server. Mai intai as dori sa pot copia toate aceste fisiere in calculatorul unde se face prelucrarea cu optiunea de a selecta dosarul sursa si dosarul destinatie.
Apoi as dori ca din fiecare foaie "Calcul" din cele 500 de fisiere sa fie copiate toate randurile cu date in coloanele A-E si lipite in foaia curenta din registrul care contine codul in colanele B-F iar in coloana A (doar in dreptul randurilor unde exista date in coloana B) sa se copieze valoarea din celula H4 sau denumirea fisierului din care se face copierea ex: "3234" sau "Mag 3234". Fisierul destinatie ar trebui mai intai golit de toate datele de pe colanele A-F pentru a nu aparea date duplicate. Fisierul obtinut va fi salvat apoi doar ca o foaie simpla de calcul si folosit pentru rapoarte cu ajutorul filtrerol si pivot table. Sper ca am fost desul de explicit si ca voi gasi pe cineva binevoitor sa ma ajute. Va multumesc
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.

electros
Mesaje: 60
Membru din: Dum Iul 29, 2012 4:38 pm

Re: Cod macro copiere si prelucrare date

Mesaj de electros » Mie Feb 03, 2021 10:42 am

Am rezolvat prima parte aproblemei cu ajutorul codului de mai jos pe care l-am gasit pe internet si l-am adaptat.

Cod: Selectaţi tot

Public Sub CopyFiles()

    Dim sPathSource As String, sPathDest As String, sFileSpec As String
    Dim Path1 As String, Path2 As String
    Dim numTimes As Integer
    sFileSpec = "*.xl**"
    For numTimes = 1 To 1 'Change 2 to number of times you want to do the procedure.....
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            Path1 = .SelectedItems(1)
        End If
    End With
        If Path1 <> "" Then
            sPathSource = Path1
        End If
       
        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show = -1 Then
                Path2 = .SelectedItems(1)
            End If
        End With
        If Path2 <> "" Then
            sPathDest = Path2
        End If
      
       
      

    Call CopyFiles_FromFolderAndSubFolders(sFileSpec, sPathSource, sPathDest)
    Next
End Sub


Public Sub CopyFiles_FromFolderAndSubFolders(ByVal argFileSpec As String, ByVal argSourcePath As String, ByRef argDestinationPath As String)

    Dim sPathSource As String, sPathDest As String, sFileSpec As String

    Dim FSO         As Object
    Dim oRoot       As Object
    Dim oFile       As Object
    Dim oFolder     As Object

    sPathSource = argSourcePath
    sPathDest = argDestinationPath

    If Not Right(sPathDest, 1) = "\" Then sPathDest = sPathDest & "\"
    If Right(sPathSource, 1) = "\" Then sPathSource = Left(sPathSource, Len(sPathSource) - 1)

    Set FSO = CreateObject("Scripting.FileSystemObject")

    If FSO.FolderExists(sPathSource) And FSO.FolderExists(sPathDest) Then
        Set oRoot = FSO.GetFolder(sPathSource)
        For Each oFile In oRoot.Files
            If LCase(oFile.Name) Like argFileSpec Then
                On Error Resume Next
                oFile.Copy sPathDest & oFile.Name
                On Error GoTo 0
            End If
        Next oFile
        For Each oFolder In oRoot.SubFolders
            ' == do the same for any folder ==
            Call CopyFiles_FromFolderAndSubFolders(argFileSpec, oFolder.Path, sPathDest)
        Next oFolder
    End If
End Sub
Acum as dori sa import toate aceste fisiere intr-o singura fila in foaia de lucru care contine codul macro dupa regulile de mai sus. Va multumesc.

csaba1960
Moderator
Moderator
Mesaje: 187
Membru din: Mie Feb 02, 2011 4:05 pm
Localitate: Cluj-Napoca

Re: Cod macro copiere si prelucrare date

Mesaj de csaba1960 » Mie Feb 03, 2021 12:30 pm

Buna
In atasament ai o posibila rezolvare.
Ce face?
La deschidere reseteza pagina de destinatie, mai putin capul de tabel.
Cu un FileDialog alegi folderul unde sunt fiserele. Programul deschide toate fiserele *.xlsx din folderul specificat. Din fisierul deschis din pagina Calcul se copiaza zona coloanelor "B:E", pana la ultimul rand cu date si se adauga la prima pagina din fisierul initial. Prima coloana se completeaza cu numele fiserului sursa.
Cam atat.
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.

electros
Mesaje: 60
Membru din: Dum Iul 29, 2012 4:38 pm

Re: Cod macro copiere si prelucrare date

Mesaj de electros » Mie Feb 03, 2021 6:34 pm

csaba1960 scrie:
Mie Feb 03, 2021 12:30 pm
Buna
In atasament ai o posibila rezolvare.
Salut, multumesc pt. raspuns si imi cer scuze ca nu am venit cu un reply mai repede dar nu am avut timp sa il testez pana acum. Solutia propusa de tine e foarte buna cu o mica exceptie. Asa cum am specificat in descrierea problemei datele din celulele foii "calcul" sunt obtinute cu ajutorul unor formule ( IF Vlookup, etc ) din celelalte foi ale acelor fisiere, in solutia ta se copiaza acele formule si nu valoarea din celule. problema e ca in unele celule apare eroarea "#REF!" iar daca fisierele sursa sunt sterse apare peste tot eroare. De aceea as dori daca se poate sa fie copiata doar valoarea din celule nu si formula. Multumesc

csaba1960
Moderator
Moderator
Mesaje: 187
Membru din: Mie Feb 02, 2011 4:05 pm
Localitate: Cluj-Napoca

Re: Cod macro copiere si prelucrare date

Mesaj de csaba1960 » Joi Feb 04, 2021 8:16 am

Buna
Revin cu modificarea facuta.
O zi buna.
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.

electros
Mesaje: 60
Membru din: Dum Iul 29, 2012 4:38 pm

Re: Cod macro copiere si prelucrare date

Mesaj de electros » Joi Feb 04, 2021 4:32 pm

csaba1960 scrie:
Joi Feb 04, 2021 8:16 am
Buna
Revin cu modificarea facuta.
O zi buna.
Buna, am testat fisierul modificat si totul merge foarte bine dar a aparut o alta problema.Cand am incarcat fisierul exemplu am folosit un fisier cu doar cateva randuri pt. ca nu m-am gandit ca e vreo problema din moment ce se verifica ultimul rand cu date. In realitate fisierele au 400-500 de randuri iar cand rulez codul propus de tine dupa fiecare fisier apare o fereasta de avertizare ca am multe date in clipboard si daca doresc sale folosesc ulterior sau golesc memoria clipboard. Nu se poate goli aceasta memorie automat fara acea fereastra pentru ca daca doresc sa rulez acest fisier pt 500 de file ar trebui sa confirm dupa fiecare? Multumesc mult pt ajutor, o zi buna.

electros
Mesaje: 60
Membru din: Dum Iul 29, 2012 4:38 pm

Re: Cod macro copiere si prelucrare date

Mesaj de electros » Joi Feb 04, 2021 5:00 pm

Dupa mai multe testari am descoperit ca trebuie sa confirm salvarea datelor din memoria clipboard nu doar golirea memorie pentr a aveaun rezultat corect in fisierul final. Multumesc, o zi buna

csaba1960
Moderator
Moderator
Mesaje: 187
Membru din: Mie Feb 02, 2011 4:05 pm
Localitate: Cluj-Napoca

Re: Cod macro copiere si prelucrare date

Mesaj de csaba1960 » Vin Feb 05, 2021 8:57 am

Buna
Incearca Application.DisplayAlerts = False la inceput si Application.DisplayAlerts = True la sfarsit, ar trebui sa ajute.

electros
Mesaje: 60
Membru din: Dum Iul 29, 2012 4:38 pm

Re: Cod macro copiere si prelucrare date

Mesaj de electros » Vin Feb 05, 2021 10:30 am

Salut am incercat si merge solutia propusa. Mai am o mica problema si totul ar fi perfect.Cand incepe sa copieze din celelalte foi daca una dintre acele foi a fost inchisa pe alt sheet decat "Calcul" primesc un mesaj de eroare cu range-ul si se opreste procesarea fisiereleor. Cum as putea face ca sheetul activ din toate fisierele sa fie "Calcul" dupa deschiderea lor ? Multumesc mult.

csaba1960
Moderator
Moderator
Mesaje: 187
Membru din: Mie Feb 02, 2011 4:05 pm
Localitate: Cluj-Napoca

Re: Cod macro copiere si prelucrare date

Mesaj de csaba1960 » Vin Feb 05, 2021 11:48 am

introduci un rand nou
Do While fiSier <> ""
nA = wsA.Cells(wsA.Rows.Count, 1).End(xlUp).Row + 1:
Set sourCe = Workbooks.Open(aFolder & "\" & fiSier, ReadOnly = True): Set ws = sourCe.Sheets("Calcul"): ' deschid fiecare fisiser
primaCol = Mid(fiSier, 1, InStr(1, fiSier, ".") - 1) ' denumire fisier sursa
nS = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row: '
ws.Select
ws.Range(Cells(2, 2), Cells(nS, 5)).Copy: wsA.Cells(nA, 2).PasteSpecial Paste:=xlPasteValues: ' copiere
sourCe.Close
nB = wsA.Cells(wsA.Rows.Count, 2).End(xlUp).Row ' ' completare prima coloana
For i = nA To nB: wsA.Cells(i, 1) = primaCol: Next
fiSier = Dir
Loop

Scrie răspuns

Înapoi la “Intrebari despre Excel 2013”