VBA - Find Open Workbook and Paste data

Nordicrx8

Board Regular
Joined
Dec 10, 2015
Messages
144
Office Version
  1. 365
Platform
  1. Windows
Hi all!


I'm trying to simplify a process to save time. I have a master file that converts several reports into one. It transforms the data and spits out tailored data for each of market areas my company supports. I have to then copy multiple selections into several other workbooks, which is time consuming. What I'd like to do is have it be a one button click to copy all the fields I need per market.

Primary ask: I want the code to search all open workbooks for a matching name. I have 7 Markets, and two components of the file name are dynamic. (Month & Market name)

MASTER FILE
Name:
SLMR Master
Market Name Location: E2
Current Month Location: K2
Current Date Location: E6

Market Workbooks
Name:
Service Level Miss (MONTH) MTD (Market Name)

Once it finds the matching Workbook, I want it to copy data from this location:

Workbook Name: SLMR Master
Tab Name: Main
Data Location: F6:AD6
Date Location: E6

To Location:

Workbook Name: Service Level Miss (MONTH) MTD (Market Name)
Tab Name: MTD Template
Data Location: C2:AA33
Date Location: B2:B33

The added twist here, is that once it finds the matching workbook, it needs to locate the correct date, and paste the data in the row.

I know this is a lot, and code will probably be complex, but if someone could help me get started I’d really appreciate it! If you need any additional information, please let me know.

Thanks so much for your time!

Best,
Chris
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Can you show us an example of the actual name of this workbook:
Service Level Miss (MONTH) MTD (Market Name)
 
Upvote 0
I didn't test it, but please try this:
VBA Code:
Sub a1180493a()
Dim wb1 As Workbook
Dim fm
With Workbooks("SLMR Master").Sheets("Main")
    Set wb1 = Workbooks("Service Level Miss " & .Range("k2") & " MTD " & .Range("e2"))
    
    fm = Application.Match(.Range("e6"), wb1.Sheets("MTD Template").Range("B2:B33"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Template").Range("C" & fm + 1 & ":AA" & fm + 1).Value = .Range("F6:AD6").Value
        End If

End With
End Sub
 
Upvote 0
Solution
I didn't test it, but please try this:
VBA Code:
Sub a1180493a()
Dim wb1 As Workbook
Dim fm
With Workbooks("SLMR Master").Sheets("Main")
    Set wb1 = Workbooks("Service Level Miss " & .Range("k2") & " MTD " & .Range("e2"))
   
    fm = Application.Match(.Range("e6"), wb1.Sheets("MTD Template").Range("B2:B33"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Template").Range("C" & fm + 1 & ":AA" & fm + 1).Value = .Range("F6:AD6").Value
        End If

End With
End Sub
You sir, are a master! I don't quite understand what all of the code means, but it works! I'll use this code as the base and add to it. Hopefully you'll be willing to assist if I end up breaking it! haha. Thank you so much!!
 
Upvote 0
I didn't test it, but please try this:
VBA Code:
Sub a1180493a()
Dim wb1 As Workbook
Dim fm
With Workbooks("SLMR Master").Sheets("Main")
    Set wb1 = Workbooks("Service Level Miss " & .Range("k2") & " MTD " & .Range("e2"))
   
    fm = Application.Match(.Range("e6"), wb1.Sheets("MTD Template").Range("B2:B33"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Template").Range("C" & fm + 1 & ":AA" & fm + 1).Value = .Range("F6:AD6").Value
        End If

End With
End Sub
Well, I didn't get far before I broke it. I tried making a small addition and it popped a runtime error, type mismatch.

I'm understanding the majority of what you wrote, except for: Range("C" & fm + 1 & ":AA" & fm + 1). COuld you explain this portion for me? I think that will help me as I build out the rest of the code.

thank you again for your help!!

VBA Code:
Sub a1180493a()
Dim wb1 As Workbook
Dim fm
With Workbooks("SLMR Master - All Regions").Sheets("Main")
    Set wb1 = Workbooks("Service Level Miss " & .Range("k2") & " MTD " & .Range("e2"))
    
    fm = Application.Match(.Range("e6"), wb1.Sheets("MTD Template").Range("B2:B33"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Template").Range("C" & fm + 1 & ":AA" & fm + 1).Value = .Range("F6:AD6").Value
    fm = Application.Match(.Range("e7"), wb1.Sheets("MTD Template").Range("B2:B33"), 0)
            wb1.Sheets("MTD Template").Range("C" & fm + 1 & ":AA" & fm + 1).Value = .Range("F7:AD7").Value
            
        End If

End With
End Sub
 
Upvote 0
Ok, so I got it to work if I do it as two separate Marcos. Thoughts on how I could combine them?

VBA Code:
Sub CP()
Dim wb1 As Workbook
Dim fm
With Workbooks("SLMR Master - All Regions").Sheets("Main")
    Set wb1 = Workbooks("Service Level Miss " & .Range("k2") & " MTD " & .Range("e2"))
        fm = Application.Match(.Range("e7"), wb1.Sheets("MTD Template").Range("B2:B34"), 0)
         If IsNumeric(fm) Then
            wb1.Sheets("MTD Template").Range("C" & fm + 1 & ":AA" & fm + 1).Value = .Range("F7:AD7").Value

          End If

End With

End Sub
Sub a1180493a()
Dim wb1 As Workbook
Dim fm
With Workbooks("SLMR Master - All Regions").Sheets("Main")
    Set wb1 = Workbooks("Service Level Miss " & .Range("k2") & " MTD " & .Range("e2"))
    
    fm = Application.Match(.Range("e6"), wb1.Sheets("MTD Template").Range("B2:B33"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Template").Range("C" & fm + 1 & ":AA" & fm + 1).Value = .Range("F6:AD6").Value
          End If
End With

End Sub
 
Upvote 0
VBA Code:
    fm = Application.Match(.Range("e6"), wb1.Sheets("MTD Template").Range("B2:B33"), 0)
        
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Template").Range("C" & fm + 1 & ":AA" & fm + 1).Value = .Range("F6:AD6").Value
        End If[/COLOR]

the code will try to find match of .Range("e6").value in Sheets("MTD Template").Range("B2:B33")

If IsNumeric(fm) Then means if it finds a match then it returns the row number to fm, but because Range("B2:B33") starts at row 2 then we need to adjust it i.e fm + 1.
so let's say .Range("e6") is "3-4-21" and it finds a match in B4 (in wb1.Sheets("MTD Template")) then fm = 3 (because it's the 3rd cell in Range("B2:B33"))
then this line:
wb1.Sheets("MTD Template").Range("C" & fm + 1 & ":AA" & fm + 1).Value
become:
wb1.Sheets("MTD Template").Range("C4:AA4").Value

if you need to do another search you need to start over, so:

VBA Code:
     fm = Application.Match(.Range("e6"), wb1.Sheets("MTD Template").Range("B2:B33"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Template").Range("C" & fm + 1 & ":AA" & fm + 1).Value = .Range("F6:AD6").Value
        End If

    fm = Application.Match(.Range("e7"), wb1.Sheets("MTD Template").Range("B2:B33"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Template").Range("C" & fm + 1 & ":AA" & fm + 1).Value = .Range("F7:AD7").Value
        End If
 
Upvote 0
VBA Code:
    fm = Application.Match(.Range("e6"), wb1.Sheets("MTD Template").Range("B2:B33"), 0)
        
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Template").Range("C" & fm + 1 & ":AA" & fm + 1).Value = .Range("F6:AD6").Value
        End If[/COLOR]

the code will try to find match of .Range("e6").value in Sheets("MTD Template").Range("B2:B33")

If IsNumeric(fm) Then means if it finds a match then it returns the row number to fm, but because Range("B2:B33") starts at row 2 then we need to adjust it i.e fm + 1.
so let's say .Range("e6") is "3-4-21" and it finds a match in B4 (in wb1.Sheets("MTD Template")) then fm = 3 (because it's the 3rd cell in Range("B2:B33"))
then this line:
wb1.Sheets("MTD Template").Range("C" & fm + 1 & ":AA" & fm + 1).Value
become:
wb1.Sheets("MTD Template").Range("C4:AA4").Value

if you need to do another search you need to start over, so:

VBA Code:
     fm = Application.Match(.Range("e6"), wb1.Sheets("MTD Template").Range("B2:B33"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Template").Range("C" & fm + 1 & ":AA" & fm + 1).Value = .Range("F6:AD6").Value
        End If

    fm = Application.Match(.Range("e7"), wb1.Sheets("MTD Template").Range("B2:B33"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Template").Range("C" & fm + 1 & ":AA" & fm + 1).Value = .Range("F7:AD7").Value
        End If
Ah, that makes sense! Thanks so much for explaining! Im still new to VBA, and can piece things together, but doing my best to learn as I go. thanks for taking the time! :)
 
Upvote 0
You're welcome, glad to help & thanks for the feedback.:)
 
Upvote 0
Update!
I was able to successfully use the above code on a dozen other items, with some modifications. Your explanation really helped me make the edits without needing to bug you again!

I have a new task, though it's fairly similar. This time I'm copying content from one tab to another in the same workbook, matching the month.

I tried editing your code, but it's popping errors.

MTD Performance
Data:
B4:B39 (Need to copy this)

YTD Performance
Month Range:
B2:M2
Data Paste Range: B3:M39 (need to match the current month to the Header in B2:M2)

MTD Template
Month Location:
BH6
(This is the sheet where the button will reside)

I'm sure I either messed something up, or I need to further alter the code. Any further help would be greatly appreciated!


VBA Code:
Sub Update_YTD()
'Dim wb1 As Workbook
Dim fm
                fm = Application.Match(.Range("BH6"), wb1.Sheets("YTD Performance").Range("B2:M2"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("YTD Performance").Range("B" & fm + 2 & ":M" & fm + 2).Value = .Range("b4:b39").Value
        End If
              
 
End With

End Sub
 
Upvote 0

Forum statistics

Threads
1,223,250
Messages
6,171,036
Members
452,374
Latest member
keccles

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top