Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 09-30-2020, 09:43 AM
rsrasc rsrasc is offline Need Help with this Macro Windows 10 Need Help with this Macro Office 2013
Competent Performer
Need Help with this Macro
 
Join Date: Mar 2014
Location: Germany
Posts: 148
rsrasc is on a distinguished road
Default Need Help with this Macro

Hi all,

The reason for posting the below code is to find out if there is a way to copy the following code to multiple workbooks.

This workbook is named "450 FY 2021 Expenses-SSE-Budget". I have other workbooks with the following names:


"025 FY 2021 Expenses-SSE-Budget"
"050 FY 2021 Expenses-SSE-Budget"
"056 FY 2021 Expenses-SSE-Budget"
"100 FY 2021 Expenses-SSE-Budget"
"130 FY 2021 Expenses-SSE-Budget"




The idea is to copy for example, the sheet named "FY 21-Budget-Expenses-Option2" in all of these workbooks and create a copy with the name "FY21-Monthly Variance Report" where the main worksheet is called in all of them "FY21-Budget-Expenses-Option2.

The first code and the second code listed below is not a problem. I can copy the information to multiple workbooks.


Code:
Sub Create_New_Monthly_Variance_Report()
Workbooks("450 FY 2021 Expenses-SSE-Budget.xlsm").Sheets("FY 21-Budget-Expenses-Option2").Copy after:=Sheets("FY 21-Budget-Expenses-Option2")
ActiveSheet.Name = "FY21-Monthly Variance Report"

End Sub


Code:
Sub Inserting_Multiple_Columns()


Workbooks("450 FY 2021 Expenses-SSE-Budget.xlsx").Sheets("FY21-Monthly Variance Report").Range("I:I").EntireColumn.Insert
Workbooks("450 FY 2021 Expenses-SSE-Budget.xlsx").Sheets("FY21-Monthly Variance Report").Range("K:K").EntireColumn.Insert
Workbooks("450 FY 2021 Expenses-SSE-Budget.xlsx").Sheets("FY21-Monthly Variance Report").Range("M:M").EntireColumn.Insert
Workbooks("450 FY 2021 Expenses-SSE-Budget.xlsx").Sheets("FY21-Monthly Variance Report").Range("O:O").EntireColumn.Insert
Workbooks("450 FY 2021 Expenses-SSE-Budget.xlsx").Sheets("FY21-Monthly Variance Report").Range("Q:Q").EntireColumn.Insert
Workbooks("450 FY 2021 Expenses-SSE-Budget.xlsx").Sheets("FY21-Monthly Variance Report").Range("S:S").EntireColumn.Insert
Workbooks("450 FY 2021 Expenses-SSE-Budget.xlsx").Sheets("FY21-Monthly Variance Report").Range("U:U").EntireColumn.Insert
Workbooks("450 FY 2021 Expenses-SSE-Budget.xlsx").Sheets("FY21-Monthly Variance Report").Range("W:W").EntireColumn.Insert
Workbooks("450 FY 2021 Expenses-SSE-Budget.xlsx").Sheets("FY21-Monthly Variance Report").Range("Y:Y").EntireColumn.Insert
Workbooks("450 FY 2021 Expenses-SSE-Budget.xlsx").Sheets("FY21-Monthly Variance Report").Range("AA:AA").EntireColumn.Insert
Workbooks("450 FY 2021 Expenses-SSE-Budget.xlsx").Sheets("FY21-Monthly Variance Report").Range("AC:AC").EntireColumn.Insert
Workbooks("450 FY 2021 Expenses-SSE-Budget.xlsx").Sheets("FY21-Monthly Variance Report").Range("AE:AE").EntireColumn.Insert
Workbooks("450 FY 2021 Expenses-SSE-Budget.xlsx").Sheets("FY21-Monthly Variance Report").Range("AG:AG").EntireColumn.Insert


End Sub


What I need is some help with the following code. BTW, I found this code and it is doing the job.


The question is, could this code be apply to multiple workbooks with a macro to the new created file named "FY21-Monthly Variance Report"?


As always thank you for your support.

v/R


Code:
Sub Copy_All_Columns()


Call Copy_Month_Column_H
Call Copy_Month_Column_J
Call Copy_Month_Column_L
Call Copy_Month_Column_N
Call Copy_Month_Column_P
Call Copy_Month_Column_R
Call Copy_Month_Column_T
Call Copy_Month_Column_V
Call Copy_Month_Column_X
Call Copy_Month_Column_Z
Call Copy_Month_Column_AB
Call Copy_Month_Column_AD


End Sub




Sub Copy_Month_Column_H()
  Dim c As Range, i As Integer, j As Integer
  i = 0
  For Each c In Range("H2:H500") 'H is the column where the value in the column is located, which is Column 8

    If c = "Oct" Then
      Cells(2 + i, 9).Value = "Oct"
      Cells(2 + i, 8) = c
    End If
    i = i + 1
  Next c
   


'https://www.datanumen.com/blogs/2-methods-copy-cells-based-certain-criteria-excel-worksheet/


End Sub

Sub Copy_Month_Column_J()
  Dim c As Range, i As Integer, j As Integer
  i = 0
  For Each c In Range("J2:J500") 'J is the column where the value in the column is located, which is Column 9

    If c = "Nov" Then
      Cells(2 + i, 11).Value = "Nov"
      Cells(2 + i, 10) = c
    End If
    i = i + 1
  Next c
   


'https://www.datanumen.com/blogs/2-methods-copy-cells-based-certain-criteria-excel-worksheet/


End Sub

Sub Copy_Month_Column_L()
  Dim c As Range, i As Integer, j As Integer
  i = 0
  For Each c In Range("L2:L500") 'N is the column where the value in the column is located, which is Column 10

    If c = "Dec" Then
      Cells(2 + i, 13).Value = "Dec"
      Cells(2 + i, 12) = c
    End If
    i = i + 1
  Next c
   


'https://www.datanumen.com/blogs/2-methods-copy-cells-based-certain-criteria-excel-worksheet/


End Sub



Sub Copy_Month_Column_N()
  Dim c As Range, i As Integer, j As Integer
  i = 0
  For Each c In Range("N2:n500") 'N is the column where the value in the column is located, which is Column 11

    If c = "Jan" Then
      Cells(2 + i, 15).Value = "Jan"
      Cells(2 + i, 14) = c
    End If
    i = i + 1
  Next c
   


'https://www.datanumen.com/blogs/2-methods-copy-cells-based-certain-criteria-excel-worksheet/


End Sub


Sub Copy_Month_Column_P()
  Dim c As Range, i As Integer, j As Integer
  i = 0
  For Each c In Range("P2:P500") 'P is the column where the value in the column is located

    If c = "Feb" Then
      Cells(2 + i, 17).Value = "Feb"
      Cells(2 + i, 16) = c
    End If
    i = i + 1
  Next c
   


'https://www.datanumen.com/blogs/2-methods-copy-cells-based-certain-criteria-excel-worksheet/


End Sub



Sub Copy_Month_Column_R()
  Dim c As Range, i As Integer, j As Integer
  i = 0
  For Each c In Range("R2:R500") 'H is the column where the value in the column is located

    If c = "Mar" Then
      Cells(2 + i, 19).Value = "Mar"
      Cells(2 + i, 18) = c
    End If
    i = i + 1
  Next c
   


'https://www.datanumen.com/blogs/2-methods-copy-cells-based-certain-criteria-excel-worksheet/


End Sub



Sub Copy_Month_Column_T()
  Dim c As Range, i As Integer, j As Integer
  i = 0
  For Each c In Range("T2:T500") 'H is the column where the value in the column is located

     If c = "Apr" Then
      Cells(2 + i, 21).Value = "Apr"
      Cells(2 + i, 20) = c
    End If
    i = i + 1
  Next c
   


'https://www.datanumen.com/blogs/2-methods-copy-cells-based-certain-criteria-excel-worksheet/


End Sub



Sub Copy_Month_Column_V()
  Dim c As Range, i As Integer, j As Integer
  i = 0
  For Each c In Range("V2:V500") 'H is the column where the value in the column is located

   If c = "May" Then
      Cells(2 + i, 23).Value = "May"
      Cells(2 + i, 22) = c
    End If
    i = i + 1
  Next c
   


'https://www.datanumen.com/blogs/2-methods-copy-cells-based-certain-criteria-excel-worksheet/


End Sub



Sub Copy_Month_Column_X()
  Dim c As Range, i As Integer, j As Integer
  i = 0
  For Each c In Range("X2:X500") 'H is the column where the value in the column is located

    If c = "Jun" Then
      Cells(2 + i, 25).Value = "Jun"
      Cells(2 + i, 24) = c
    End If
    i = i + 1
  Next c
   


'https://www.datanumen.com/blogs/2-methods-copy-cells-based-certain-criteria-excel-worksheet/


End Sub



Sub Copy_Month_Column_Z()
  Dim c As Range, i As Integer, j As Integer
  i = 0
  For Each c In Range("Z2:Z500") 'H is the column where the value in the column is located

    If c = "Jul" Then
      Cells(2 + i, 27).Value = "Jul"
      Cells(2 + i, 26) = c
    End If
    i = i + 1
  Next c
   


'https://www.datanumen.com/blogs/2-methods-copy-cells-based-certain-criteria-excel-worksheet/


End Sub



Sub Copy_Month_Column_AB()
  Dim c As Range, i As Integer, j As Integer
  i = 0
  For Each c In Range("AB2:AB500") 'H is the column where the value in the column is located

    If c = "Aug" Then
      Cells(2 + i, 29).Value = "Aug"
      Cells(2 + i, 28) = c
    End If
    i = i + 1
  Next c
   


'https://www.datanumen.com/blogs/2-methods-copy-cells-based-certain-criteria-excel-worksheet/


End Sub



Sub Copy_Month_Column_AD()
  Dim c As Range, i As Integer, j As Integer
  i = 0
  For Each c In Range("AD2:AD500") 'H is the column where the value in the column is located

    If c = "Sep" Then
      Cells(2 + i, 31).Value = "Sep"
      Cells(2 + i, 30) = c
    End If
    i = i + 1
  Next c
   


'https://www.datanumen.com/blogs/2-methods-copy-cells-based-certain-criteria-excel-worksheet/


End Sub
Attached Files
File Type: xlsm 450 FY 2021 Expenses-SSE-Budget-good1.xlsm (431.1 KB, 4 views)
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Need Help with this Macro Footnote extraction macro [Why is this macro so slow? / anyway to make it faster?] Le_Blanc Word VBA 10 03-22-2021 11:38 AM
Spell check macro within macro button field doesn't work in one document samuelle Word VBA 0 07-20-2016 02:27 AM
Need Help with this Macro Macro Question: Need help making a macro to highlight the first word in every sentence LadyAna Word 1 12-06-2014 10:39 PM
Macro Needed to bold specific lines and Macro to turn into CSV anewteacher Word VBA 1 05-28-2014 03:59 PM
custom icon, undo/redo for macro, permanent macro Rapier Excel 0 08-05-2013 06:30 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 04:26 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft