Copy and paste based on month and file name

ASadStudent

New Member
Joined
Oct 26, 2022
Messages
20
Office Version
  1. 365
Platform
  1. Windows
Hello everyone,
I got helped before with a macro that copies amounts from 1 excel file to another excel file based on the names that are in the B column. It also makes the B column red if it didn't find anything to copy it to.
Now I need to add a couple more things to this macro so I wanted to ask if anyone could help me with this.

This is what the original macro does:
My macro copies data from 1 excel document sheet to another. The document where the data is coming from is called “report” and the document where the data needs to go to is called “maandverband”. The sheets in both documents are just called Sheet1.

The data is copied based on the product name that is in the B Column of both documents. If the product names on both files match then it needs to copy the amount that is in the N column in the “report” document to the F Column in the “Maandverband” document.

This is what I want to add:
What I want to add to this code is that there are multiple places where it can copy the data to. Now there are 12 columns where the amounts need to go to and it needs to copy the amount to the correct location based on file name. For example you have 12 columns, amount january, amount february etc until you get amount december.
The "report" file where the amounts come from also has different names based on month of the year. So for example report january, report february etc until report december.

What I want the code to do is that when it sees that the file name is "report february" that it puts the amounts found in the map in the correct column
For example the file name is "report january" so it copies the amount in the N column of "report january" and pastes it into the F column of the file "Maandverband".


Here is what my code looks like right now:
VBA Code:
Sub CopyPasteCode()
  Dim report As Worksheet, Maandverband As Worksheet
  Dim data As Variant, ky As Variant
  Dim lr As Long, rw As Long
  Dim d As Object, d2 As Object
  Dim rng As Range
 
  Set d = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
 
  Set report = Workbooks.Item("Report").Sheets("Sheet1")
  Set Maandverband = Workbooks.Item("Maandverband").Sheets(1)
 
  lr = report.Cells(Rows.Count, 2).End(3).Row
  With report.Cells(1, 1).Resize(lr, 14)
    data = .Value
    .Interior.ColorIndex = xlNone
  End With
 
  For rw = LBound(data) To UBound(data)
    If data(rw, 14) <> 0 Then
      ky = data(rw, 2)
      If Not d.exists(ky) Then
        d(ky) = data(rw, 14) & "|" & rw
      End If
    End If
  Next rw
 
  lr = Maandverband.Cells(Rows.Count, 2).End(3).Row
  data = Maandverband.Cells(1, 1).Resize(lr, 6).Formula
 
  For rw = LBound(data) To UBound(data)
    ky = data(rw, 2)
    d2(ky) = Empty
    If d.exists(ky) Then
      data(rw, 6) = Split(d(ky), "|")(0)
    End If
  Next rw

  For Each ky In d.keys
    If Not d2.exists(ky) Then
      rw = Split(d(ky), "|")(1)
      If rng Is Nothing Then
        Set rng = report.Cells(rw, 2)
      Else
        Set rng = Union(rng, report.Cells(rw, 2))
      End If
    End If
  Next
 
  If Not rng Is Nothing Then rng.Interior.Color = vbRed
  Maandverband.Cells(1, 6).Resize(UBound(data)).Formula = Application.Index(data, 0, 6)
End Sub

And here is what the excel file sheets look like:
Report January.xlsx
ABCDEFGHIJKLMNO
1Product nameAmount sold
2Product 150
3Product 2165
4Product 3163
5Product 4643
6Product 534
7Product 62
8Product 775
9Product 893
10Product 966
11Product 1085
12Product 1145
13Product 1278
14Product 1335
15Product 1429
16Product 1561
17Product 16144
18Product 1772
19Product 180
20Product 190
21Product 205
22
23
Sheet1





Maandverband.xlsx
ABCDEFGHIJKLMNOPQR
1ProductNameAmount in JanuaryAmount in FebruaryAmount in MarchAmount in AprilAmount in MayAmount in JuneAmount in JulyAmount in AugustAmount in SeptemberAmount in OctoberAmount in NovemberAmount in December
2Product 1
3Product 2
4Product 3
5Product 4
6Product 5
7Product 6
8Product 7
9Product 8
10Product 9
11Product 10
12Product 11
13Product 12
14Product 13
15Product 14
16Product 15
17Product 16
18Product 17
19Product 18
20Product 19
21Product 20
22
Sheet1


Thanks a bunch for helping me solve my problem.
 
Last edited:

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

Forum statistics

Threads
1,223,243
Messages
6,170,964
Members
452,371
Latest member
Frana

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