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:

 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:

 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",""),"")))