98.7% Of all customers recommend us, we're so confident about our results we publish all reviews and stats
View Live Stats View Reviews
Forum home » Delegate support and help forum » Microsoft Excel VBA Training and help » Copy data from tab of an open workbook to looped worksheets
Copy data from tab of an open workbook to looped worksheets
Resolved · Urgent Priority · Version 365
Thu 25 May 2023, 18:23Delegate Lauren said...
Lauren has attended:
Excel VBA Introduction course
Copy data from tab of an open workbook to looped worksheets
Hi,
The below macro goes through a series of files named "LR Tax Pack March 2023****.x***) to update information on each file and to add a new tab called "LR Reviewer checklist".
There will be a file open called "new tab" with a tab named also "LR Reviewer checklist". I need to copy the data from this "new tab" file to each file that has been opened and had the tab "LR Reviewer checklist" created to bring the data from the "new tab" file.
In the macro below, before the 100 number I wrote the macro:
Sheets.Add(After:=Sheets("BACKING")).Name = "LR Reviewer Checklist" (to create the tab in the already open "LR Tax Pack March 2023***** file - this is a series of files in a loop)
Workbooks("new tab.xlsx").Worksheets("LR Reviewer checklist").Range("A1:D75").Copy_ (I am telling to get the data from the "new tab" file which will be already open and from its "LR Reviewer checklist" tab
Workbooks.Worksheets("LR Reviewer Checklist").Range ("A1") (this is the hard bit - the destination file - how do I get to paste the data in the tab on the "LR Tax Pack March 2023 **** file? I can not put a file name here because the file name changes as the below macro goes through the files using a loop to update various items in each single file).
Please could you assist?
Thank you and Kind Regards,
Lauren
Sub patch()
'
' Patch Macro
'
On Error GoTo 999
Dim patch As Variant
patch = ActiveWorkbook.Name
Dim password As String
password = "tbc"
FileType = "LR Tax Pack March 2023*.X*" 'The file type to search for
FilePath = "S:\lon_grpspt_finance\Group Tax\1. Year end reporting\2023\2.0 Tax templates\Test - patch to add new GL codes & saturn\" 'The folder to search
'FilePath = "\\internal.lr.org\shares\lon_grpspt_finance_ipm\IPM_Finance\All_Users\General\2020 Tax Packs\Patch\filesforpatching\" 'The folder to search
Dim OutputCol As Variant
Dim Curr_File As Variant
Dim FldrWkbk As Workbook
Curr_File = Dir(FilePath & FileType)
Do Until Curr_File = ""
Application.EnableEvents = False
Application.DisplayAlerts = False
Set FldrWkbk = Workbooks.Open(FilePath & Curr_File, UpdateLinks:=3) ', IgnoreReadOnlyRecommended:=True 'Open new data file
Dim filename As Variant
Dim filen As Variant
Application.EnableEvents = False
Sheets("Pack Version").Select
ActiveSheet.Unprotect (password)
Dim vernum As Variant
vernum = ActiveSheet.Range("a4").Value
If vernum = 1.1 Then GoTo 100 Else
Sheets("Trial Balance").Select
ActiveSheet.Unprotect (password)
Range("F7").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D7").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=+'BPC Linked TB'!R[2]C[-2]"
Rows("833:834").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B833").Select
ActiveCell.FormulaR1C1 = "661070 - Franchise Fees"
Range("B834").Select
ActiveCell.FormulaR1C1 = "661080 - Prior Year Franchise Fees"
Range("D833").Select
ActiveCell.Formula = "=iferror(VLOOKUP(B833,'BPC Linked TB'!$A:$B,2,FALSE),0)"
Range("D834").Select
ActiveCell.Formula = "=iferror(VLOOKUP(B834,'BPC Linked TB'!$A:$B,2,FALSE),0)"
Range("F833").Select
ActiveCell.Formula = "=iferror(VLOOKUP(B833,'BPC Linked TB'!$A:$D,4,FALSE),0)"
Range("F834").Select
ActiveCell.Formula = "=iferror(VLOOKUP(B834,'BPC Linked TB'!$A:$D,4,FALSE),0)"
Range("I833").Select
ActiveCell.FormulaR1C1 = "0"
Range("I834").Select
ActiveCell.FormulaR1C1 = "0"
Range("K832").Select
Selection.AutoFill Destination:=Range("K832:K834"), Type:=xlFillDefault
Range("K832:K834").Select
ActiveSheet.Protect (password)
Sheets("Input").Select
ActiveSheet.Unprotect password:="tbc"
Rows("88:88").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H79").Select
Selection.Copy
Range("F88").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Range("H88").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("J79").Select
Selection.Copy
Range("J88").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("F87:J87").Select
Selection.Copy
Range("F89").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A88").Select
ActiveCell.FormulaR1C1 = "Saturn Capital gains tax"
Range("A89").Select
ActiveCell.FormulaR1C1 = "Total current year current tax"
Range("H88").Select
ActiveCell.Formula = "=SUM(IF(LEFT($A$2,5)='Data (Local)'!$F$1:$HC$1,IF($O88='Data (Local)'!$A$2:$A$1100,IF($R88='Data (Local)'!$D$2:$D$1100,'Data (Local)'!$F$2:$HC$1100))))"
Cells.Replace What:="@", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByColumns, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
, FormulaVersion:=xlReplaceFormula2
Range("A88").Select
Selection.Copy
Range("A89").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("F89").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
Range("H89").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
Range("J89").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
Range("O87").Select
ActiveCell.FormulaR1C1 = "do not delete"
Range("O88").Select
ActiveCell.FormulaR1C1 = "P&L Tax Charge - Entity"
Range("P88").Select
ActiveCell.FormulaR1C1 = "Transfer pricing reserves"
Range("Q88").Select
ActiveCell.FormulaR1C1 = "'P&L Tax Charge - Entity'!90"
Range("R88").Select
ActiveCell.FormulaR1C1 = "ID67"
ActiveSheet.Protect password:="tbc"
Sheets("BS Tax Accounts - Entity").Select
ActiveSheet.Unprotect password:="tbc"
Range("G20").Select
Selection.ClearContents
Range("L49:L70").Select
Selection.ClearContents
Range("P49:P70").Select
Selection.Copy
Range("L49").Select
ActiveSheet.Paste
Range("L91:L112").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("R91:R112").Select
Selection.Copy
Range("L91").Select
ActiveSheet.Paste
ActiveSheet.Protect password:="tbc"
Sheets("Return to Accruals").Select
ActiveSheet.Unprotect password:="tbc"
Rows("90:90").Select
Selection.Cut
Rows("89:89").Select
ActiveSheet.Paste
Range("D92:H92").Select
Selection.Cut
Range("D90").Select
ActiveSheet.Paste
Range("F85").Select
Selection.Copy
Range("F91:H91").Select
ActiveSheet.Paste
Range("F89:H89").Select
Application.CutCopyMode = False
Selection.Copy
Range("F92").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("F92").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
Range("F92").Select
Selection.AutoFill Destination:=Range("F92:G92"), Type:=xlFillDefault
Range("F92:G92").Select
Range("H91").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=+RC[-1]-RC[-2]"
Range("H92").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=+RC[-1]-RC[-2]"
Range("F91").Select
ActiveCell.FormulaR1C1 = "=-INPUT!R[-3]C[2]"
Range("G91").Select
ActiveCell.FormulaR1C1 = "=-INPUT!R[-3]C[3]"
Range("B91").Select
ActiveCell.FormulaR1C1 = "Tax on Saturn disposal"
Range("F103").Formula = "=Sum(F92:F102)"
Range("G103").Formula = "=Sum(G92:G102)"
Range("H103").Formula = "=Sum(H92:H102)"
Range("C110").Formula = "=-F92"
Range("C116").Formula = "=-G92"
Sheets("Export").Select
ActiveSheet.Unprotect password:="tbc"
Range("G754").Formula = "='Return to Accruals'!$F$92"
Range("G835").Formula = "='Return to Accruals'!$G$92"
Range("G916").Formula = "='Return to Accruals'!$H$92"
Range("A1029:A1031").Select
Selection.Copy
Range("A1038").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C1035:C1037").Select
Application.CutCopyMode = False
Selection.Copy
Range("C1038").Select
ActiveSheet.Paste
Range("D1038").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "ID350"
Range("D1039").Select
ActiveCell.FormulaR1C1 = "ID351"
Range("D1040").Select
ActiveCell.FormulaR1C1 = "ID352"
Range("D1041").Select
Sheets("Return to Accruals").Select
Range("B91").Select
Selection.Copy
Sheets("Export").Select
Range("B1038:B1040").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G1038").Select
ActiveCell.FormulaR1C1 = "=+'Return to Accruals'!R91C6"
Range("G1039").Select
ActiveCell.FormulaR1C1 = "=+'Return to Accruals'!R91C7"
Range("G1040").Select
ActiveCell.FormulaR1C1 = "=+'Return to Accruals'!R91C8"
Range("A1038:G1040").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveSheet.Protect password:="tbc"
Sheets("Return to Accruals").Select
ActiveSheet.Protect password:="tbc"
Sheets.Add(After:=Sheets("BACKING")).Name = "LR Reviewer Checklist"
Workbooks("new tab.xlsx").Worksheets("LR Reviewer checklist").Range("A1:D75").Copy_
Workbooks.Worksheets("LR Reviewer Checklist").Range ("A1")
100
'patch
'following steps are used to refresh the TB
'Sheets("BPC Linked TB").Select
' Dim EPMObj As New FPMXLClient.EPMAddInAutomation
'EPM.SetActiveConnection ActiveSheet, "_FPM_BPCNW10_[https://vhlrgbppci.lrg.rot.hec.sap.biz:44300/sap/bpc/]_[LR_GROUP]_[Consolidation]_[false]_[false]"
' EPMObj.RefreshActiveSheet
960
Sheets("Pack Version").Select
ActiveSheet.Unprotect (password)
Range("A4").Select
ActiveCell.FormulaR1C1 = "1.1"
Range("d2").Select
ActiveSheet.Unprotect
Selection.ClearContents
ActiveCell.FormulaR1C1 = "1.1"
ActiveSheet.Protect (password)
Application.EnableEvents = True
Application.DisplayAlerts = False
FldrWkbk.Save
FldrWkbk.Close SaveChanges:=False 'Close the data file
Application.DisplayAlerts = True
Curr_File = Dir 'Select Next File
Loop
MsgBox ("Workbooks updated successfully.")
Exit Sub
Fri 26 May 2023, 10:39Trainer Jens said...
RE: copy data from tab of an open workbook to looped worksheets
Hi Lauren,
Thank you for the forum question.
Your question:
"how do I get to paste the data in the tab on the "LR Tax Pack March 2023 **** file? I can not put a file name here because the file name changes as the below macro goes through the files using a loop to update various items in each single file)."
IF you open all the files you want to loop through, you can use a FOR EACH loop.
The code below will loop through all open files
Sub LoopEachOpenWorkbook()
Dim wb As Workbook
For Each wb In Application.Workbooks
Write the code here you want to happen in each open workbook
Next wb
End Sub
Or if you have all the files you want to loop through in one folder and nothing else in the folder.
Option Explicit
Sub LoopAllWorkbooks()
'variable to store information in the computer's memory
Dim FolderPath As String 'store the folderpath in the computer's memory
Dim FileName As String 'store the file name inthe computer's memory
Dim WorkBk As Workbook 'store the name of each workbook in the computer's memory
Dim blankrow As Long 'store the row number of the first blank row in destination sheet
Dim varAllData As Variant 'array. Will store all records from the source workbooks
'error handling. If there is an error Excel will go to the bottom of the macro where the error name is
'On Error GoTo ErrHandler
'speed up macro. Stops Excel from updating screen while macro is running
Application.ScreenUpdating = False
'stops Excel from showing dialog boxes while running macro.
Application.DisplayAlerts = False
'open the select directory dialog box
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
'"IF THEN ELSE" decision code. If folder is selected then store the folder path in the variable folderpath
If .Show = -1 Then '-1 = yes or true
FolderPath = .SelectedItems(1) & "\"
'if folder is not selected the user will get a mesaage box and Excel will exit the macro
Else
MsgBox "FilePath not selected!", , "Path selecter"
Exit Sub
End If
End With
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xl*")
' Loop until Dir returns an empty string.
Do Until FileName = ""
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & "\" & FileName)
WRITE THHE CODE HERE YOU WANT TO HAPPEN IN ALL THE FILES IN THE FOLDER.
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
' Use Dir to get the next file name.
FileName = Dir()
'end of loop
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Copy and paste is not a good idea in VBA. Using Arrays to move data is much more efficient.
Kind regards
Jens Bonde
Microsoft Office Specialist Trainer
Tel: 0207 987 3777
STL - https://www.stl-training.co.uk
98%+ recommend us
London's leader with UK wide delivery in Microsoft Office training and management training to global brands, FTSE 100, SME's and the public sector
Training information:
|
Welcome. Please choose your application (eg. Excel) and then post your question. Our Microsoft Qualified trainers will then respond within 24 hours (working days). Frequently Asked Questions
Any suggestions, questions or comments? Please post in the Improve the forum thread. |
Excel tip:Make macros work in newer versions of ExcelIf you have created macros in Excel 97 or 2000 that you want to be able to use in 2002/XP or 2003, you may need to alter the macro security settings in the newer version of Excel you are using. |
