VBA for Finance structure to Database structure (Copy & Paste)

[Dn Dilf]

Hi everybody,

I use this forum as much as I can to look for better ways to use Excel, but I'mn ot that good with VBA and I need ome help for restructuring some finance data into a Database tab.

I have 4 tabs, identical formatting except the amounts per Month are different. The 4 tabs represent Actuals, Forecast, Outlook and Business Plan (hence same structure for comparison but different numbers). In cells C5:J50 there are descriptions to group all info and in cells K5:V50 is the finance info per Month (January = K5:K50, feb = L5:L50…etc).

What I need: Copy/paste cells C5:J50 from tab Actuals with descriptions into tab Database, start on cell A2. In tab Database add in column J2:J50 1 for the period Janury. Then copy/paste from tab Actuals cells K5:K50 (January numbers) into tab Database again in cells K2:K50. And then repeat for February so you all info is underneath each other. Of course, the period should be filled in 2 for Feb etc.
After 12 times and all actuals are copied, move to tab Forecast and repeat all of the above until all 4 tabs are converted.

Hopefully this makes sense when you guys read it, always more difficult to explain it in words.

Thanks for the help

 

[jondavis1987]

I'm confused by you what you want. I understand you want cells C5:J50 from Actuals to go into Database starting at A2. From there i get confused. Are you wanting it to paste into A2:H50? if so, here's a code for that.

Sub Open_Workbook() 
    Dim srcWB As Workbook
 
'   Capture current workbook as source workbook
    Set srcWB = ActiveWorkbook
 
 
 
'   Copy data from source workbook to destination workbook
srcWB.Sheets("Actuals").Range("C5:C50").Copy
    srcWB.Sheets("Database").Range("A2").Resize(46, 1).PasteSpecial xlPasteValues
srcWB.Sheets("Actuals").Range("D5:D50").Copy
    srcWB.Sheets("Database").Range("B2").Resize(46, 1).PasteSpecial xlPasteValues
srcWB.Sheets("Actuals").Range("E5:E50").Copy
    srcWB.Sheets("Database").Range("C2").Resize(46, 1).PasteSpecial xlPasteValues
srcWB.Sheets("Actuals").Range("F5:F50").Copy
    srcWB.Sheets("Database").Range("D2").Resize(46, 1).PasteSpecial xlPasteValues
srcWB.Sheets("Actuals").Range("G5:G50").Copy
    srcWB.Sheets("Database").Range("E2").Resize(46, 1).PasteSpecial xlPasteValues
srcWB.Sheets("Actuals").Range("H5:H50").Copy
    srcWB.Sheets("Database").Range("F2").Resize(46, 1).PasteSpecial xlPasteValues
srcWB.Sheets("Actuals").Range("I5:I50").Copy
    srcWB.Sheets("Database").Range("G2").Resize(46, 1).PasteSpecial xlPasteValues
srcWB.Sheets("Actuals").Range("J5:J50").Copy
    srcWB.Sheets("Database").Range("H2").Resize(46, 1).PasteSpecial xlPasteValues
 
 
 
 
 
 
 
 
End Sub

After that, i'm confused about what you want in the database. I need you to explain the adding of the J2:J50 for january. I'm also confused how you want cells K5:K50 to paste into K2:K50. The way you're wording it you want to paste more cells then you copied.

 

[jondavis1987]

and where is the data for february and where do you want it pasted for february

 

[Fluff]

Not sure if I've understood correctly, or not, but try

Sub Dn_Dilf()
   Dim Ws As Worksheet, Sht As Worksheet
   Dim i As Long, NxtRw As Long
   
   Set Ws = Sheets("Database")
   NxtRw = 2
   For Each Sht In Sheets(Array("Actuals", "Forecast", "Outlook", "Business Plan"))
      Sht.Range("C5:J50").Copy Ws.Range("A" & NxtRw).Resize(46 * 12, 8)
      For i = 11 To 22
         Ws.Range("J" & NxtRw).Resize(46).Value = i - 10
         Sht.Cells(5, i).Resize(46).Copy Ws.Cells(NxtRw, 11)
         NxtRw = NxtRw + 46
      Next i
   Next Sht
End Sub

 

[Dn Dilf]

Thanks for looking into this, as non of the above really work well let's try this:

Sub fill_DB()
   Dim srcWB As Workbook
 
'   Capture current workbook as source workbook
    Set srcWB = ActiveWorkbook
 
 
 
'   Copy data from source workbook to destination workbook
    srcWB.Sheets("Actual CY").Range("C5:J50").Copy
    srcWB.Sheets("Database").Range("A2").Resize(46 * 12, 8).PasteSpecial xlPasteValues
    srcWB.Sheets("Actual CY").Range("C57:J103").Copy
    srcWB.Sheets("Database").Range("A554").Resize(47 * 12, 8).PasteSpecial xlPasteValues
    srcWB.Sheets("Actual CY").Range("C110:J132").Copy
    srcWB.Sheets("Database").Range("A1118").Resize(23 * 12, 8).PasteSpecial xlPasteValues
    
    ' Jan:
    srcWB.Sheets("Actual CY").Range("K5:K50").Copy
    srcWB.Sheets("Database").Range("M2").PasteSpecial xlPasteValues
    srcWB.Sheets("Actual CY").Range("K57:K103").Copy
    srcWB.Sheets("Database").Range("M48").PasteSpecial xlPasteValues
    srcWB.Sheets("Actual CY").Range("K110:K132").Copy
    srcWB.Sheets("Database").Range("M95").PasteSpecial xlPasteValues

    srcWB.Sheets("Actual CY").Range("K2").Copy
    srcWB.Sheets("Database").Range("I2").Resize(1 * 116).PasteSpecial xlPasteValues
    
    ' Feb:
    srcWB.Sheets("Actual CY").Range("M5:M50").Copy
    srcWB.Sheets("Database").Range("M118").PasteSpecial xlPasteValues
    srcWB.Sheets("Actual CY").Range("M57:M103").Copy
    srcWB.Sheets("Database").Range("M164").PasteSpecial xlPasteValues
    srcWB.Sheets("Actual CY").Range("M110:M132").Copy
    srcWB.Sheets("Database").Range("M211").PasteSpecial xlPasteValues
    srcWB.Sheets("Actual CY").Range("L2").Copy
    srcWB.Sheets("Database").Range("I118").Resize(1 * 116).PasteSpecial xlPasteValues
    
    'Mar:
     
 
 
End Sub

This actually works, but as you can see I'm not done yet. There is still a lot of copy/pasting to do and finding out on what cells the pasting should start etc..
Does this help in my explanation?

Thanks agan

 

[Fluff]

Will it always be rows 5:50,57:103 & 110:132?
If so is it those rows on each sheet?

 

[Dn Dilf]

Yes it is. All 4 input tabs are the same so I use the same numbers (5:50 etc), and of course there are 12 Months so from colum K to V.

 

[Fluff]

How about

Sub Dn_Dilf()
   Dim Ws As Worksheet, Sht As Worksheet
   Dim i As Long, NxtRw As Long, j As Long
   Dim Ary As Variant
   
   Set Ws = Sheets("Database")
   Ary = Array(5, 46, 57, 47, 110, 23)
   NxtRw = 2
   For Each Sht In Sheets(Array("Actuals", "Forecast", "Outlook", "Business Plan"))
      For j = 0 To UBound(Ary) Step 2
         Sht.Range("C" & Ary(j)).Resize(Ary(j + 1), 8).Copy Ws.Range("A" & NxtRw).Resize(Ary(j + 1) * 12, 8)
         For i = 11 To 22
            Ws.Range("J" & NxtRw).Resize(Ary(j + 1)).Value = i - 10
            Sht.Cells(Ary(j), i).Resize(Ary(j + 1)).Copy Ws.Cells(NxtRw, 11)
            NxtRw = NxtRw + Ary(j + 1)
         Next i
      Next j
   Next Sht
End Sub

 

[Dn Dilf]

Yes! That's it.
I had to read it a couple of times to get my head around it, but after some small fine tuning adjustments I'm good to go.

Many thanks!

 

[Fluff]

You're welcome & thanks for the feedback