Import date din mai multe fisiere excel

[miirceabarbu]

Buna ziua,
Daca ma puteti ajuta cu codul pentru importarea unor anumite date (din celule diferite) din mai multe fisiere excel.
Am incercat dar nu am reusit.
Datele care doresc sa se importe le-am trecut in fisierul "00.Centralizator RN 2022.xlsm". Datele de unde se importa sunt in fisierele "RN_1_Servicii de transport public.xlsm" si :RN_1_Servicii de transport public.xlsm". Tipul fisierelor din care se importa poate fi si "*.xls" sau "*.xlsx"
Mentionez ca structura fisierelor din care se importa este identica.
Va multumesc frumos.
P.S. Am gasit in subiectul "macro -copiere date din mai multe fisiere" dar nu reusesc sa deschid arhiva.

[IPP]

Buna ziua

Atasat aveti spre testare o propunere folosind macro.

In aceasta forma am presupus ca:
-Atat fisierul unde se va face centralizarea cat si cele sursa sunt in acelasi folder/subfolder (personal as fi optat pentru un subfolder dedicat care sa adaposteasca la un moment dat doar fisierele sursa pentru a se evita dublarea informatiei ca urmare a rularii accidentale a codului de mai multe ori)
-codul macro isi extrage dinamic calea si direct (nu tine cont de formula pusa de dvs. in celula A1
-Daca va lipsi (la sursa) informatia ce urmeaza a fi pusa pe coloana B, prelucrarea va fi gresita (sau codul va trebui modificat pe baza unei informatii despre care veti sti ca INTOTDEAUNA va fi completata)
-NU vor exista alte informatii in foaie pentru ca in forma asta vor fi suprascrise la un moment dat sau prelucrarea va fi gresita.

Am folosit urmatorul cod:

Cod: Selectaţi tot

Sub CentralizareInfo()

'IPP - 08.05.2022

Application.ScreenUpdating = False

Dim MyFolder As String
Dim MyFile As String

MyFolder = ThisWorkbook.Path + "\"
MyFile = Dir(MyFolder + "*.xls*")

If MyFile = "" Then
 MsgBox "Nu exista fisiere *.xls* de prelucrat"
 Exit Sub
End If

Do While MyFile <> ""

Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

If MyFile <> ThisWorkbook.Name Then
 Workbooks.Open Filename:=MyFolder + MyFile
 Windows(MyFile).Activate

With ThisWorkbook.Sheets("Sheet1").Range("B1000000").End(xlUp).Offset(1, 0)
.Value = Range("A6").Value
.Offset(0, 1) = Range("G8")
.Offset(0, 2) = Range("C22")
.Offset(0, 3) = Range("C23")
.Offset(0, 4) = Range("C24")
.Offset(0, 5) = Range("C25")
.Offset(0, 6) = Range("C26")
.Offset(0, 7) = Range("C28")
.Offset(0, 8) = Range("E28")
.Offset(0, 9) = Range("F82")
.Offset(0, 10) = Range("F83")
    .Offset(0, 10).NumberFormat = "0%"
.Offset(0, 11) = Range("F84")
.Offset(0, 12) = Range("G116")
.Offset(0, 13) = Range("B116")
End With

   ActiveWindow.Close
    
End If
    
 MyFile = Dir
Loop

Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Pentru testare: folositi un folder in care sa copiati fisierele de test si fisierul atasat aici. Deschideti fisierul si rulati codul macro

IP

[miirceabarbu]

Buna ziua
Va multumesc frumos. Este ceea ce imi trebuie. Functioneaza exect cum am dorit.
Cu stima,
Mircea B

[miirceabarbu]

Buna ziua,
Am incercat sa modific codul pentru a copia randul (randurile completate, dupa conditia din coloana B, adica sa copieze randurile daca in coloana B este completat) de la B32 la G32 (in cazul exemplelor atasate). Va rog, daca ma puteti ajuta, adaptand solutia realizata de dumneavoastra. Eu am realizat ceva in modulul 1 (mai rudimentar), dar lucreaza destul de greu.
Va multumesc frumos!

Cu stima,
Mircea B

[IPP]

Buna ziua

Probabil ar trebui sa atasati un exemplu mai concret si apoi explicatiile necesare pentru a partea cu "intregul rand" e cam neclara.

Altfel, am mai detectat o potentiala problema: codul anterior presupunea ca in fisierele sursa exista doar foaia de interes sau daca exista mai multe, foaia de interes este cea activa. Asadar si aici ar trebui sa se modifice in cod pentru a seleta in prealabil foaia de interes. Iar daca, de la fisier la fisier foaia aceea se numeste altcumva...

IP

[miirceabarbu]

Buna ziua
Doresc sa copiez informatiile din randurile 32, 33, 34....etc.(daca este completat denumirea produsului) de la coloana B la coloana G pentru ca doar acelea sunt completate.
In fisierele sursa denumirea foii este identica.
Atasez fisierele necesare.
Va multumesc!

Cu stima
Mircea B

[IPP]

Poate nu am observat eu dar in fisierul destinatie nu ati aratat cum si mai ales unde sa fie copiata (daca exista) informatia din zona B32:G50 din fisierele sursa

Solicitarea anterioara arata ca si cum ati dori un centralizator la nivel de totaluri, a doua seamana cu o cerinta ce are menirea de a extrage toate detaliile la nivel de rand(uri) pentru a putea fi la un moment dat prelucrate dupa alte criterii

[miirceabarbu]

Buna ziua
Am incercat in modulul 1 dar as dori pe codul realizat de dumneavoastra.
Cred ca nu am atasat fiserul bun. Il mai atasez inca o data.

"Solicitarea anterioara arata ca si cum ati dori un centralizator la nivel de totaluri, a doua seamana cu o cerinta ce are menirea de a extrage toate detaliile la nivel de rand(uri) pentru a putea fi la un moment dat prelucrate dupa alte criteri"
- exact!!


Cu stima
Mircea B

[IPP]

Buna ziua

Testati fisierul atasat.

Am mai adaugat o foaie, Sheet2 (daca doriti sa redenumiti, va trebui sa editati in cod)
Ca parte a prelucrarii, in aceasta foaie vor fi copiate informatiile respective

IP

[miirceabarbu]

Buna ziua
Este exact ceea ce doresc, dar as dori sa copieze datele ca valori in shhet ul 2.
Va multumesc!

Cu stima
Mircea B