If value from specific cells match with Sheet.Name in another Workbook then Copy-Paste

[MarBer]

Hello everyone,

I have Problems to optimize a VBA routine.
In this routine when the value in the column "Room Number" matches the value I specify, then it moves the data to the specified cells on Sheet 2 of Workbook 2. The Name of this Sheet2 has the same as a the value of the column "Room Number".
In this case I will have a Macro for each "Room Number" since I have to specify what the value of the "Room Number" is in each Macro.


Sub Transferdata()
Dim ws1 As Worksheet, ws2 As Worksheet, i As Long
Dim lastrow As Long

strFirstFile = "X:\47_LGB\Schriftverkehr\4. Nutzer\04_Raumprogramm\WB1.xlsm"
strSecondFile = "X:\47_LGB\Schriftverkehr\4. Nutzer\04_Raumprogramm\WB2.xlsm"

Set wbk1 = Workbooks.Open(strFirstFile)
Set ws1 = wbk1.Sheets("DATA")

Set wbk2 = Workbooks.Open(strSecondFile)
Set ws2 = wbk2.Sheets("00.001")

lastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow

If ws1.Cells(i, 1).Value = "00.001" Then

ws2.Cells(1, 1).Value = ws1.Cells(i, 2).Value
ws2.Cells(1, 2).Value = ws1.Cells(i, 3).Value

End If
Next

ws1.Close SaveChanges:=False
End Sub


Since I have a lot of Rooms, I would like to optimize it like that:

A-Find values in the column "No. of Rooms" in book 1 that match with a Sheetname in book 2. For example the value will be 00.001
B-Selections of cell values in the row where the value "00.001" is found in book 1
C-Select the Sheet in book 2 with the name 00.001 as the active page
D-Copy the data from the cells of book 1 (Step B) into specific cells of the corresponding active sheet (Step C)


I was just wondering if someone could help with the match of cells with Sheetname and on the corresponding sheet .

Thank you for any possible assistance.

Best regards,
Maria.

PD: the data of wb1.ws1 are regularly updated but remains in the same position. "Room Number" never changes. There ar

 

[CountTepes]

Once you have your workbook object.

Set wbk2 = Workbooks.Open(strSecondFile)

You can then do:

For Each ws2 in wbk2
'
'      --------  Your code goes here
'
Next

You now no longer have to do Set ws2 = wbk2.Sheets("00.001")

So you can have one piece of code which will loop through all the worksheets.

 

[MarBer]

Thank you very much for the answer!
Now when he finds the first match he does the action I want. However, it copies the data from the first match row (ws1) onto all the Worksheets from wb2, not just in the Worksheet that has the same name. That is, it match value A from row x (wb1) with Sheet A (wb2) copies the values from row x onto sheets A, B,C, etc.
But what I want is that match value A (Row x, wb1) with Sheetname A (wb2) and the values I specify from Row x (wb1) to Sheet A(wb2). And afterwards should continue with the Looping so it would match value B (Row y, wb1) with Sheet B (wb2) and copy the values from Row y (wb1) to Sheet B (wb2). And so on ...
To make the Code work I actually had to add the For Each ws2 In wbk2.Worksheets and ws2.Activate so it would actually Transfer some data.

The Code Looks like this:

Sub E0LISTA()

Dim ws1 As Worksheet, ws2 As Worksheet, i As Long
Dim lastrow As Long

strFirstFile = "X:\47_LGB\Schriftverkehr\4. Nutzer\04_Raumprogramm\0_Raumliste\E0_LGB_Raumliste.xlsx"
strSecondFile = "X:\47_LGB\Schriftverkehr\4. Nutzer\04_Raumprogramm\0_Raumliste\PROBEAUTO.xlsm"

Set wbk1 = Workbooks.Open(strFirstFile)
Set ws1 = wbk1.Sheets("Blockdaten")
Set wbk2 = Workbooks.Open(strSecondFile)

For Each ws2 In wbk2.Worksheets

lastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow

If ws1.Cells(i, 1).Value = ws2.Name Then

ws2.Activate

Else

ws2.Cells(1, 1).Value = ws1.Cells(i, 2).Value
ws2.Cells(1, 2).Value = ws1.Cells(i, 3).Value

End If
Next
Next
End Sub

 

[CountTepes]

My mistake. I forgot the .Worksheets after wb2

 

[MarBer]

So any idea how to make it work that match value A (Row x, wb1) with Sheetname A (wb2) and the values I specify from Row x (wb1) to Sheet A(wb2, and afterwards continues with the Looping so it would match value B (Row y, wb1) with Sheet B (wb2) and copy the values from Row y (wb1) to Sheet B (wb2), and so on... So I it doesn't copy always just the values from Row x?

Sorry I'm new in VBA ?

 

[CountTepes]

Can you give an example of the data you are reading and the output you want?

 

[MarBer]

I can't upload n Image becase it's too heavy but I try to explain:

In wb1.ws("Blockdaten") I have a table where each row has datas (text) from a specific room. So at the end I have in the columns different informations as Name of the room, Surface of he room, material of walls, etc. One row contains all the information of one room.
This WB1 it's actuallized from time to time, for example when the Surface of the room changes, ths actualization it's done directly from the Programm AutoCAD.

But all this Information has to go to the wb2 that it was given to me as an official Template where each Sheet is a room. The Name of each Sheet of wb2 is the same as the "Room number" and the rest of Information of the room it's distributed in non contiguous cells in the Sheet. This sheet templates are always the same so for example:
The Surface of the room in wb2 it's Always in teh cell (10, 9).
The Surface of the room in wb1 it's always on the Column C; the row depends on which room I want to extract the Information.

The reading data and the Output data ist Always going to be in text format.

In one Code I would like to find Matches betweeen the wb1.ws1.Column_Raumnummer with wb2.Worksheets.Name
When it finds a match then should Transfer/copy the values from the non contiguous cells from the row with the matched Roomnumber in wb1 to the non contiguous cells from the Sheet with the matched Roomnumber on wb2. After it copies this Information should search the next match and do the same.
So each row in wb1 would correspond to a Sheet in wb2.

 

[CountTepes]

I think you just need to get rid of the else statement. You are copying data if the room has not been matched.

Which column is the name of the room in WB1? If it is in a fixed position, then the code may be simplified a lot and also sped up.

 

[MarBer]

It works without the Else! Thank you, you saved me so much time!