PDA

View Full Version : VBA - copy specific cells with criteria to multiple workbooks (get filename from cell



keresztesi
08-19-2018, 01:38 AM
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


1
AZON
Terület
Probléma leírása
Kategória
Felelős
Határidő
Visszaküldve
file
KÉSZ


2
terület1_1
CORAZZA
sfgfsgfg
Sebességet befolyásoló
John Doe
2018.08.31

terület1



3
terület1_2
REX
sfgvsfgf
Munkabiztonság



terület1



4
terület3_1
TZR1
ethbet
Akut



terület3



5
terület4_1
CORAZZA
aaaa
Preventív
Paula Abdul
2018.09.10
x
terület4





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
08-21-2018, 04:54 AM
I have a similar vba code, that I run before that one I need.
In that case it only copy some cells to another (given) workbook and "x" to cells after that.

Is it helpful for somebody who understands vba better?

Here is the code:
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("TMK")


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

keresztesi
08-21-2018, 10:13 AM
Ok, finally I have something.
I could write a code that fulfills my needs. There is only one more thing that must have fixed.

Here is the code:
Sub Vissza_terület()


Dim LastRow As Integer
Dim i As Integer
Dim wbk As Workbook
Dim SourceSheet As Worksheet
Dim DestSheet As Worksheet
Dim AZON, Felelős, Határidő


Set SourceSheet = ThisWorkbook.Sheets("TMK")
LastRow = SourceSheet.Range("A" & Rows.Count).End(xlUp).Row

Set wbk = Workbooks.Open("d:\terület2.xlsm")
Set DestSheet = wbk.Sheets("terület2")


For i = 2 To LastRow
If SourceSheet.Cells(i, 5).Value <> "" And SourceSheet.Cells(i, 6) <> "" And SourceSheet.Cells(i, 7) = "" Then
'change the column numbers to the relevant number
AZON = SourceSheet.Cells(i, 1).Value
Felelős = SourceSheet.Cells(i, 5).Value
Határidő = SourceSheet.Cells(i, 6).Value

If DestSheet.Cells(i, 1).Value = AZON Then

DestSheet.Cells(i, 8).Value = Felelős
DestSheet.Cells(i, 9).Value = Határidő
SourceSheet.Cells(i, 7) = "x"
End If
End If
Next i

wbk.Save
'wbk.Close

End Sub


The problem is that it only runs properly when all criteria meet in row number 2.
It should check all raws from 2nd to lastrow, then continue.

I hope somebody can help me.

Thx

keresztesi
08-21-2018, 10:14 AM
Because I only have 6 different destination files, I thoght I rename "terület1" to "terület2" , "...3" and so on.