VBA - copy specific cells with criteria to multiple workbooks (get filename from cells)

[keresztesi]

Hi,

I need your help.
Here is a sample table.

So I need the following:

1. IF ColE and ColF are not blank and ColG is blank then
2. Copy the values from ColE and ColF to another workbook
3. ColH contains the workbook name (path will be always the same)
4. It should copy these values to the given workbook, given worksheet column number 8 and 9
5. For row number it should search for "AZON" in colA which is identical in source and destination workbooks ("AZON" is always in ColA)
6. After copy was succesfull it should write an "x" to ColG in the sourcesheet

	A	B	C	D	E	F	G	H	I
AZON	Terület	Probléma leírása	Kategória	Felelős	Határidő	Visszaküldve	file	KÉSZ
terület1_1	CORAZZA	sfgfsgfg	Sebességet befolyásoló	John Doe	2018.08.31	terület1
terület1_2	REX	sfgvsfgf	Munkabiztonság				terület1
terület3_1	TZR1	ethbet	Akut				terület3
terület4_1	CORAZZA	aaaa	Preventív	Paula Abdul	2018.09.10	terület4

<tbody>
[TD="align: right"]1[/TD]

[TD="align: right"]2[/TD]

[TD="align: center"][/TD]

[TD="align: right"]3[/TD]

[TD="align: right"]4[/TD]

[TD="align: right"]5[/TD]

[TD="align: center"]x[/TD]

</tbody>

So, in that example the code should copy values "John Doe" and "2018.08.31" to the workbook "terület1". Row number is where "terület1_1" is in workbook "terület1", the values go to row numbers 8 and 9. After that it writes an "x" to column G.

Thank you in advance!

Zoli

 

[keresztesi]

I have a similar vba, but in that case I don't need to copy data to different workbooks.
Is it a help for somebody to rewrite it?

Sub exportData()


Dim LastRow As Integer
Dim i As Integer
Dim erow As Integer
Dim wbk As Workbook
Dim SourceSheet As Worksheet
Dim DestSheet As Worksheet
Dim Sorszám, AZON, Terület, Probléma_leírása, Kategória, File


Set SourceSheet = ThisWorkbook.Sheets("terület1")
LastRow = SourceSheet.Range("A" & Rows.Count).End(xlUp).Row
Set wbk = Workbooks.Open(ThisWorkbook.Path & "\TMK.xlsm")
Set DestSheet = wbk.Sheets("Munka1")


For i = 2 To LastRow
If SourceSheet.Cells(i, 7).Value = "" And SourceSheet.Cells(i, 1) <> "" Then
'change the column numbers to the relevant number
AZON = SourceSheet.Cells(i, 1).Value
Terület = SourceSheet.Cells(i, 4).Value
Probléma_leírása = SourceSheet.Cells(i, 5).Value
Kategória = SourceSheet.Cells(i, 6).Value
File = SourceSheet.Cells(i, 2).Value

SourceSheet.Cells(i, 7) = "x"

erow = DestSheet.Cells(DestSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row


'change the column numbers to the relevant number
DestSheet.Cells(erow, 1).Value = AZON
DestSheet.Cells(erow, 2).Value = Terület
DestSheet.Cells(erow, 3).Value = Probléma_leírása
DestSheet.Cells(erow, 4).Value = Kategória
DestSheet.Cells(erow, 8).Value = File
End If
Next i



wbk.Save
'wbk.Close
End Sub


Thx
Zoli

 

[keresztesi]

Somebody, please!

 

[keresztesi]

I have this above:
Set wbk = Workbooks.Open(ThisWorkbook.Path & "\TMK.xlsm")

How can I change it not to use "TMK.xlsm" but use always the proper filename from cell values from row.

Thx