VBA Copy to another workbook if match multiple criteria.

[Busiga]

Hi all,

Im trying to figure out how to loop through a who workbook and copy value if for example B5 value match Sheet name in the other workbook, then i should copy value from E5 to that sheet and place it under the right column so if its for August month it gets the data from then it should paste it just under August(A3) in the other workbook, for Example August is in cell E6 the data should be placed in E7.. And if its the Sales the sale should copied aswell.

Im trying to figure this out but since i dont have enought knowledge im hitting the head in the wall all the time..


This is where the data sheet looks like, and each month have an own sheet (Aug-16) and so on.


And data should be copied to another workbook that looks like this.





So basicly im getting stucked kinda fast have tried too google and find hints on how to do it but not been successful so far.

Tried to make a macro on my own, and this is how far i came.

[FONT=arial]Sub test()[/FONT]
[FONT=arial]
[/FONT]
[FONT=arial]Dim rng As Range[/FONT]
[FONT=arial]Dim row As Range[/FONT]
[FONT=arial]Dim cell As Range[/FONT]
[FONT=arial]Dim WB1 As Workbook[/FONT]
[FONT=arial]Dim wb2 As Workbook[/FONT]
[FONT=arial]Dim ws As Worksheet[/FONT]
[FONT=arial]Dim Ws2 As Worksheet[/FONT]
[FONT=arial]
[/FONT]
[FONT=arial]    Set WB1 = ThisWorkbook[/FONT]
[FONT=arial]    Set wb2 = Workbooks.Open("F:\Excel\Chef\<wbr>NPS Samtal 777 agentnivå.xlsx")[/FONT]
[FONT=arial]rng = Range("CB:B40")[/FONT]
[FONT=arial]
[/FONT]
[FONT=arial]For Each ws In wb2[/FONT]
[FONT=arial]For Each row In rng.Rows[/FONT]
[FONT=arial]  For Each cell In row.Cells[/FONT]
[FONT=arial]  If cell.Value = "" Then[/FONT]

[FONT=arial] If rng.Value = WB1.ws Then[/FONT]
[FONT=arial] MsgBox "hi"[/FONT]
[FONT=arial] Else[/FONT]
[FONT=arial] End If[/FONT]

[FONT=arial] End If[/FONT]
[FONT=arial]  Next cell[/FONT]
[FONT=arial]Next row[/FONT]
[FONT=arial]Next[/FONT]
[FONT=arial]
[/FONT]
[FONT=arial]End Sub[/FONT]

Yeah i know its now even close... but am im on the right way with the first part of the code..

The sheet may contain sometimes more and sometimes less names under B4 (Agents) it depends on month... So some kind of error handling might be needed? Dont know realy.


Anyone have any clue how this could be done.. As u notice im not that well oriented on this thingie..

Gladly take any help i can get.

Best regards
Daniel

 

[JLGWhiz]

See if this works for you

Sub postSales()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, wb2 As Workbook, fn As Range
Set sh1 = ThisWorkbook.ActiveSheet
Set wb2 = Workbooks.Open("F:\Excel\Chef\NPS Samtal 777 agentnivå.xlsx")
    For Each c In sh1.Range("B5", sh1.Cells(Rows.Count, 2).End(xlUp))
        Set sh2 = wb2.Sheets(c.Value)
        Set fn = sh2.Rows(5).Find(sh1.Range("A3").Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
                fn.Offset(1) = c.Offset(, 3).Value
            End If
    Next
End Sub

 

[Busiga]

Thanks for the help with the code,

At the moment i receive "Subscription out of range" on the following part,

 Set sh2 = wb2.Sheets(c.Value)

Correct me if im wrong now, that means that the c.value returns nothing that matches the sheet names? Or maybe nothing at all?
Can it be that i have to bind the result of the c.value to something for each loop?

Thanks again for the time and effort.

//Daniel

 

[JLGWhiz]

Thanks for the help with the code,

At the moment i receive "Subscription out of range" on the following part,

 Set sh2 = wb2.Sheets(c.Value)

Correct me if im wrong now, that means that the c.value returns nothing that matches the sheet names? Or maybe nothing at all?
Can it be that i have to bind the result of the c.value to something for each loop?

Thanks again for the time and effort.

//Daniel

Make sure your sheet names in wb2 are exactly like the names in your sh1 column B list. They are case sensitive so if one is capitalize and the other is not, it will error. also check for leading or trailing spaces and change the code to this:

Set sh2 = wb2.Sheets(Trim(c.Value))

 

[Busiga]

Since i really cant get it to work i assume my information wasnt that good... So here i go again... ill upload the whole workbook as a spreadsheet of how it looks...

https://docs.google.com/spreadsheets/d/14CyC2CQWWH-Bxifw2EBni0Uj2YjlN-kIUVki2rle3LA/edit?usp=sharing
From that file i want to copy from F column to the sheet in other workbook. So if August is mentioned in B5, it should copy to this workbook:
https://docs.google.com/spreadsheets/d/1vcfnluE_PSm5dEEeHuBPA9XRoP-VPQRk3YDE7ONS-NE/edit?usp=sharing
And in that file it should copy to J22 (since august in first wb) cause i only gather NPS procentage from that workbook.

Not even sure its possible to make it work, but if u have some easy tuning for it i really would appreciate it.

 

[Busiga]

Make sure your sheet names in wb2 are exactly like the names in your sh1 column B list. They are case sensitive so if one is capitalize and the other is not, it will error. also check for leading or trailing spaces and change the code to this:

Set sh2 = wb2.Sheets(Trim(c.Value))

Yeah rechecked and renamed all sheets and also the cell's and didnt manage to get it to work.. still same error..

 

[JLGWhiz]

Yeah rechecked and renamed all sheets and also the cell's and didnt manage to get it to work.. still same error..

well, I figured out why you are getting the error. None of your worksheets are named for the value in B5. Your worksheet names correspond to the values in column C beginning at E8.
I have revised the code based on the examples in the link posted. I still don't understand exactly what the objective is, but maybe you can work with this.

Sub postSales()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, wb2 As Workbook, fn As Range
Set sh1 = ThisWorkbook.ActiveSheet
Set wb2 = Workbooks.Open("F:\Excel\Chef\NPS Samtal 777 agentnivå.xlsx")
    For Each c In sh1.Range("C8", sh1.Cells(Rows.Count, 3).End(xlUp))
        Set sh2 = wb2.Sheets(c.Value)
        Set fn = sh2.Rows(24).Find(sh1.Range("B5").Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
                fn.Offset(1) = sh1.Range("E5").Value
            End If
    Next
End Sub