'Copy Columns A,B,C and D to Master Spreadsheet
Dim lr As Long
Dim lrC As Long
Dim wbTarget As Workbook 'Master
Dim wbThis As Workbook 'Current Open Workbook
Dim strName As String 'Name for source sheet/target workbook
Dim thePath As String 'Path for Master Spreadsheet
Application.ScreenUpdating = False
'set the current active workbook
Set wbThis = ActiveWorkbook
'set the target workbook name
strName = "TargetFile"
'set the path to the Comments Spreadsheet
thePath = "C:\YourFullPath" 'Make sure that this has all subfolder names included
'open Master Spreadsheet
Set wbTarget = Workbooks.Open(thePath & strName & ".xlsm")
'Activate the Target Workbook
'Find the last row in the target workbook
lrC = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
'activate source workbook
'find the last row in column A to determine the range to copy
lr = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
'clear any thing on the clipboard to mazimize available memory
Application.CutCopyMode = False
'Copy Data in Columns A,B,C,D
wbThis.Sheets("Sheet1").Range("A2:E" & lr).Copy
'paste the data to the Comments Worksheet
wbTarget.Sheets("Sheet1").Range("A" & lrC + 1).PasteSpecial
'Clear the clipboard
Application.CutCopyMode = False
Application.ScreenUpdating = True
Set wbTarget = Nothing
Set wbThis = Nothing
MsgBox "Data Transferred"
Thanks for your reply. It appears however that your code takes only a single file ("target file"), the name for which is hard coded. But I have a couple dozen files that I want to copy the formatting to, so i need a looping structure that takes a differently named xlsx file in each loop and, (1) opens it, (2) formats the single sheet within the file, (3) saves it, (4) closes it, and then moves on to the next xlsx file in the folder until there are no more xlsx files to copy formatting to.
Here is some code for looping through a sub-directory. I will need to play with this for your situation as it does not solve your issue but demonstrates only how to loop. You would need to have all the target files in one subfolder and no other files in that folder for a start. Its been awhile for me since I have done that and would need to play and test before I publish.
If in the short term you are willing to use this code, then you could put an Inputbox that asks the user for the name of the file for the target instead of hard coding.
An alternative would be to have the names of all the files to be a target in a separate Open File and loop through those names for the target.
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim ws As Worksheet
Dim sPath As String
Dim lrA As Long
Dim lrB As Long
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ws = Worksheets.Add
'Get the folder object associated with the directory
sPath = InputBox("What is the full Path to Search?")
Set objFolder = objFSO.GetFolder(sPath)
ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & " are:"
ws.Cells(1, 2).Value = "The files found have modified dates:"
ws.Cells(1, 3).Value = "The file Size is:"
'Loop through the Files collection
For Each objFile In objFolder.Files
'If objFile.Name Like "*.pdf" Then
lrA = Range("A" & Rows.Count).End(xlUp).Row
lrB = Range("B" & Rows.Count).End(xlUp).Row
ws.Range("A" & lrA + 1).Value = objFile.Name
ws.Range("B" & lrB + 1).Value = objFile.DateLastModified
ws.Range("C" & lrB + 1).Value = objFile.Size
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing