VBA - Find Open Workbook and Paste data

Nordicrx8

Board Regular
Joined
Dec 10, 2015
Messages
87
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
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
3,560
Office Version
  1. 365
Platform
  1. Windows
I don't understand your data layout.
You want to copy B4:B39 to B3:M39? the row size are different, 4 to 39 and 3 to 39
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

Nordicrx8

Board Regular
Joined
Dec 10, 2015
Messages
87
I don't understand your data layout.
You want to copy B4:B39 to B3:M39? the row size are different, 4 to 39 and 3 to 39
I think I have it mostly figured out, but it's pasting over the header (Month) Do you know of a way to have the paste function to start one row down?

VBA Code:
Sub Update_YTD()
  Dim foundCell As Range, sh1, sh2 As Worksheet
  
  Set sh1 = Sheets("MTD Performance")
  Set sh2 = Sheets("YTD Performance")
  
  Set foundCell = sh2.Range("B:M").Find(sh1.Range("A1").Value, , xlValues, xlWhole)
  If Not foundCell Is Nothing Then
    sh1.Range("B4:B39").Copy
    foundCell.PasteSpecial xlPasteValues
    foundCell.PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
  Else
    Call MsgBox("Data match not detected. Check MTD Performance Cell A1", vbExclamation, "Finding String")
  End If
End Sub
 

Nordicrx8

Board Regular
Joined
Dec 10, 2015
Messages
87
Oh! I got working! Woo! :)

VBA Code:
Sub Update_YTD()
  Dim foundCell As Range, sh1, sh2 As Worksheet
  
  Set sh1 = Sheets("MTD Performance")
  Set sh2 = Sheets("YTD Performance")
  
  Set foundCell = sh2.Range("B:M").Find(sh1.Range("A1").Value, , xlValues, xlWhole)
  If Not foundCell Is Nothing Then
    sh1.Range("B4:B39").Copy
    foundCell.Offset(1, 0).PasteSpecial xlPasteValues
    foundCell.Offset(1, 0).PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
  Else
    Call MsgBox("Data match not detected. Check MTD Performance Cell A1", vbExclamation, "Finding String")
  End If
End Sub
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
3,560
Office Version
  1. 365
Platform
  1. Windows
Good job. (y)
It looks like you're having fun learning VBA.:)
 

Nordicrx8

Board Regular
Joined
Dec 10, 2015
Messages
87

ADVERTISEMENT

Good job. (y)
It looks like you're having fun learning VBA.:)
I am! I wish I knew more, but this board has been a tremendous resource. Thanks again for all your help - I appreciate you!
 

Nordicrx8

Board Regular
Joined
Dec 10, 2015
Messages
87
Good job. (y)
It looks like you're having fun learning VBA.:)
Hi Akuini!

I was hoping you could help me one last time! My workbook is shaping up quite nicely! Since others will be using this WB too, I wanted to add in a popup message box alerting the user if no matching open workbooks are found. Currently it pops a VBA error message if it doesn't find a match, which would cause confusion.

Thanks so much for all your help! :)
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
3,560
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Perhaps this would suffice:
VBA Code:
Sub CP()
Dim wb1 As Workbook
Dim fm
On Error GoTo skip:
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

'..rest of the original code here

Exit Sub


skip:
If Err.Number = 9 Then
    MsgBox "Can't find the workbook"
Else
    MsgBox Err.Description
End If

End Sub
 

Nordicrx8

Board Regular
Joined
Dec 10, 2015
Messages
87
Perhaps this would suffice:
VBA Code:
Sub CP()
Dim wb1 As Workbook
Dim fm
On Error GoTo skip:
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

'..rest of the original code here

Exit Sub


skip:
If Err.Number = 9 Then
    MsgBox "Can't find the workbook"
Else
    MsgBox Err.Description
End If

End Sub
You're amazing - thanks so much for all your help!! It works perfectly!
 

Forum statistics

Threads
1,148,241
Messages
5,745,579
Members
423,962
Latest member
PisaTorauh

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
Top