Cod VBA Excel - copiere informatii in workbook

gecs, on 2nd October 2010, 12:35, said:

sandra_m, on 4th October 2010, 10:01, said:

SELECT *
FROM `D:\Clienti\Clienti.xlsx`.`'client 1$'` `'client 1$'`
UNION
SELECT *
FROM `D:\Clienti\Clienti.xlsx`.`'client 2$'` `'client 2$'`
UNION
SELECT *
FROM `D:\Clienti\Clienti.xlsx`.`'client 3$'` `'client 3$'`

Option Explicit
Option Base 1
Public Const fact_s = "factura scadenta", cli_txt = "client "


Sub Actualizeaza_Scadente()
	Dim rg_cl, rg_scad, cl, rand_cl As Range
	Dim i, j, k As Long
	Application.ScreenUpdating = False
	With ActiveSheet
		.Range("A2").Select
		Range(Selection, Selection.End(xlDown)).Select
		Range(Selection, Selection.End(xlToRight)).Select
		Selection.Clear
		.Range("A2").Select
	End With
	j = 2
	For i = 1 To 25
		Application.StatusBar = cli_txt & i
		ThisWorkbook.Worksheets(cli_txt & i).Activate
		With ActiveSheet
			.Range("A2").Select
			Range(Selection, Selection.End(xlDown)).Select
			Range(Selection, Selection.End(xlToRight)).Select
			Set rg_cl = Selection
			For k = 1 To rg_cl.Rows.Count
				Set rand_cl = rg_cl.Rows(k)
				If rand_cl.Cells(9).Value = fact_s Then
					rand_cl.Copy
					ThisWorkbook.Worksheets("scadente").Activate
					With ActiveSheet
						.Range("A" & j).Select
						Selection.Value = cli_txt & i
						.Range("B" & j).Select
						.Paste
						j = j + 1
					End With
					ThisWorkbook.Worksheets(cli_txt & i).Activate
				End If
			Next k
			.Range("A2").Select
		End With
	Next i
	ThisWorkbook.Worksheets("scadente").Activate
	Range("A2").Select
	Application.SendKeys ("{ESC}")
	Application.StatusBar = False
	Application.ScreenUpdating = True
End Sub

Edited by gecs, 04 October 2010 - 11:58.

gecs, on 4th October 2010, 12:56, said:

Option Explicit
Option Base 1
Public Const fact_s = "factura scadenta", cli_txt = "client "


Sub Actualizeaza_Scadente()
	Dim rg_cl, rg_scad, cl, rand_cl As Range
	Dim i, j, k As Long
	Application.ScreenUpdating = False
	With ActiveSheet
		.Range("A2").Select
		Range(Selection, Selection.End(xlDown)).Select
		Range(Selection, Selection.End(xlToRight)).Select
		Selection.Clear
		.Range("A2").Select
	End With
	j = 2
	For i = 1 To 25
		Application.StatusBar = cli_txt & i
		ThisWorkbook.Worksheets(cli_txt & i).Activate
		With ActiveSheet
			.Range("A2").Select
			Range(Selection, Selection.End(xlDown)).Select
			Range(Selection, Selection.End(xlToRight)).Select
			Set rg_cl = Selection
			For k = 1 To rg_cl.Rows.Count
				Set rand_cl = rg_cl.Rows(k)
				If rand_cl.Cells(9).Value = fact_s Then
					rand_cl.Copy
					ThisWorkbook.Worksheets("scadente").Activate
					With ActiveSheet
						.Range("A" & j).Select
						Selection.Value = cli_txt & i
						.Range("B" & j).Select
						.Paste
						j = j + 1
					End With
					ThisWorkbook.Worksheets(cli_txt & i).Activate
				End If
			Next k
			.Range("A2").Select
		End With
	Next i
	ThisWorkbook.Worksheets("scadente").Activate
	Range("A2").Select
	Application.SendKeys ("{ESC}")
	Application.StatusBar = False
	Application.ScreenUpdating = True
End Sub

gecs, on 4th October 2010, 15:56, said:

Codul trebuie copiat intr-un modul, nu intr-o foaie noua de calcul.

In arhiva atasata e un fisier .xls care contine un exemplu cu situatia din fisierul tau, asa cum am inteles-o din explicatiile de la primul mesaj:
- o foaie denumita scadente in care se face centralizarea;
- 25 de foi denumite client 1, client 2,... client 25 in care exista cate un tabel identic cu 9 coloane, iar pe ultima coloana pentru cateva inregistrari apare textul "factura scadenta".

In foaia scadente, langa tabelul de 10 coloane exista un buton cu textul Actualizeaza - daca apesi pe acel buton tabelul din acea foaie e refacut si cuprinde numai inregistrarile din celelalte 25 de foi care pe ultima coloana au inscris textul "factura scadenta". Functionarea acestei proceduri poti s-o verifici modificand in oricare din cele 25 de tabele valorile din ultima coloana si apasand din nou pe butonul cu pricina. Valorile numerice care apar in cele 25 de tabele sunt aleatoare.

Daca dupa verificare ai constatat ca procedura functioneaza corect, poti sa copiezi tabelele tale peste cele 25 de tabele din fisierul meu si vei avea un fisier functional cu datele reale. Cu un Save As cu alt nume decat cel al fisierului tau de date pastrezi si datele originale si poti sa testezi in continuare. Daca e vreo problema cu functionarea macro-ului, imi spui si o corectam.

Nu uita sa permiti activarea macro-ului la deschiderea fisierului.

Facturi_..._Clienti.rar

sandra_m, on 5th October 2010, 08:56, said:

gecs, on 5th October 2010, 09:42, said:

Edited by gecs, 05 October 2010 - 09:19.

gecs, on 5th October 2010, 10:19, said:

L-am modificat, astfel incat daca in foile de clienti nu exista decat header-ul tabelului (ala e musai sa fie), nu se mai supara ca nu are date in rest si trece mai departe.

Verifica si cu date si fara date (doar header) si spune-mi, te rog, daca functioneaza cum trebuie.

Facturi_...._cl1_R1.rar

sandra_m, on 5th October 2010, 10:40, said:

gecs, on 5th October 2010, 10:45, said:

N-ar trebui sa aiba importanta daca sunt informatii in anumite coloane si in altele nu...

Poti sa atasezi fisierul in care a dat eroare?

Edited by gecs, 05 October 2010 - 12:40.

gecs, on 5th October 2010, 13:39, said:

Am modificat codul, dar eroarea era de la valoarea formulei folosite pe coloana I, pe care o mai si formatasesi sa foloseasca font de culoare alba daca formula returneaza eroare !!!  

In foaia client 1 am modificat formulele - daca iti convine cum sunt acum, le pastrezi si le poti folosi si in celelalte tabele, daca nu - nu.

Te rog testeaza functionarea macro-ului si spune-mi daca mai face figuri.

Am mai adaugat 2 foi in fisier: Banci si Valute. In foile alea poti sa intretii listele de banci si de valute (fiecare scrisa o singura data pe coloana A; pot fi pana la 100 de banci si 20 de valute) astfel incat sa le folosesti si in tabelele din foile pentru clienti. Header-ul si primul rand (inclusiv formulele si celulele cu drop-down combo facute cu Data Validation) din tabelul din foaia client 1 l-am copiat si in foile 'client 5':'client 25'. Daca nu-ti place asa, le inlocuiesti cu formatul de tabel care-ti convine. Poti sa le inlocuiesti pe toate dintr-un foc cu o selectie 3d: click pe eticheta foii (tab-ul) client 5 -> mergi la sfarsitul listei de foi -> apesi si tii apasata tasta Shift -> click pe eticheta foii client 25 - scum toate aceste foi sunt selectate si ce modifici intr-una se va modifica in toate. Ca sa dezactivezi selectia 3d dai un click pe tab-ul unei foi care nu face parte din selectie.

Facturi_...._cl1_R2.rar

sandra_m, on 5th October 2010, 14:08, said:

=IF(LEN($E2)=0,"",IF(LEN($F2)=0,IF(TODAY()=$E2,"factura scadenta",IF(TODAY()<$E2,"","scadenta depasita")),IF(ISNUMBER($F2),IF($F2>$E2,"scadenta depasita",""),"")))