Copy specific cells in multiple protected files to summary workbook

anj123

New Member
Joined
Jun 15, 2015
Messages
5
Hi,

I'm new to VBA and have managed to created a macro to copy data from specific cells in a protected workbook (file1.xlsx) located in a folder (C:\Results) to a summary workbook (Summary.xlsm). I have up to 900 files in the Results folder and need to complete the same copy paste for each file. The filename for each file needs to be inserted into Column A and the first 2 rows contain headers so all pasted values will start from row 3 onward.

I'm having trouble repeating this macro for the rest of the files in the folder. Is anyone able to help me adapt my macro for multiple files?

Sub CopyCells()
Workbooks.Open filename:= _
"C:\Results\file1.xlsx" 'Open file in folder
ActiveSheet.Unprotect Password:="123" 'Remove password protection
Dim ws As Worksheet
Set ws = ActiveWorkbook.Worksheets.Item(1) 'Use only the first sheet in workbook
fNAME = ActiveWorkbook.Name
Range("G19:G21,G24:G26,G29:G31,G34:G36,G39:G41").Select
Selection.Copy 'Copy specific cells
Windows("Summary.xlsm").Activate 'Switch to summary excel file in current worksheet
Range("A3") = fNAME 'Insert file1 name into cell A3
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True 'Paste copied values from file worksheet into row 3 from column B onwards
End Sub

Many thanks!
 

Some videos you may like

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney

jbeaucaire

Well-known Member
Joined
May 8, 2002
Messages
6,012
I'm thinking this should work once you edit the name of the wsDEST:
Rich (BB code):
Option Explicit

Sub CopyCells()
Dim fPATH As String, fNAME As String, wbDATA As Workbook
Dim NR As Long, wsDEST As Worksheet

Application.ScreenUpdating = False                      'speed up macro by not showing progress onscreen

Set wsDEST = ThisWorkbook.Sheets("Sheet1")              'target sheet in this workbook, edit the sheetname as needed
NR = wsDEST.Range("A" & Rows.Count).End(xlUp)(1).Row    'next empty row on destination

fPATH = "C:\Results\"                                   'remember the final \ in this string
fNAME = Dir(fPATH & "*.xlsx")                           'get first filename

Do While Len(fNAME) > 0                                 'loop through filenames until no more are found
    Set wbDATA = Workbooks.Open(fPATH & fNAME)                              'open the found file
    wsDEST.Range("A" & NR).Value = fNAME                                    'add filename to column A
    wbDATA.Sheets(1).Range("G19:G21,G24:G26,G29:G31,G34:G36,G39:G41").Copy  'copy data from first sheet in found file
    wsDEST.Range("B" & NR).PasteSpecial xlPasteValues, Transpose:=True      'paste/transpose into empty row column B
    wbDATA.Close False                                  'close the found file
    NR = NR + 1                                         'increment to next empty row
    fNAME = Dir                                         'get the next filename
Loop

Application.ScreenUpdating = True                       'refresh screen once at the end
End Sub
 

anj123

New Member
Joined
Jun 15, 2015
Messages
5
It works a treat! Many thanks - I'd been going around in circles for ages with this. Is copying without using select how you're able to avoid having to unprotect the sheet?
 

jbeaucaire

Well-known Member
Joined
May 8, 2002
Messages
6,012
The macro recorder is a great tool for getting needed syntax and clues on the direction needed to find specific parameters you're looking for, but the macro recorder is recording your human actions, so the first thing people see is ".select" and ".activate" events recorded into the code and think, "great, that's how you do it.". No, that's your human actions being played back to you.

VBA is much more surgical and concise. It has no such need to physically look at things (active) nor touch it ahead of time (select) prior to DOING something on a sheet, none at all. Once you learn to properly target all your commands to specific sheets/ranges/objects, things get much more efficient and often easier.

Perfect example from your own code:

Recorder:
Code:
Range("G19:G21,G24:G26,G29:G31,G34:G36,G39:G41").Select
 Selection.Copy 'Copy 
 Windows("Summary.xlsm").Activate 'Switch to summary excel file in current worksheet
 Range("A3") = fNAME 'Insert file1 name into cell A3
 Range("B3").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks :=False, Transpose:=True

Better:
Code:
wsDEST.Range("A" & NR).Value = fNAME
wb.Sheets(1).Range("G19:G21,G24:G26,G29:G31,G34:G36,G39:G41").Copy
wsDEST.Range("B" & NR).PasteSpecial xlPasteValues Transpose:=True


Another example is recording yourself doing something as simple as changing the font size on a cell... the recorded code is VERY long because it records you setting ALL the physical characteristics of the cell, even the items you DIDN'T change. The best time to edit that code is right after you record it since YOU know all you did was change the font size, you can most likely edit out ALL the other code.

Recorder:
Code:
    Range("B3").Select
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

All we need from that:
Code:
    ThisWorkbook.Sheets("Sheet1").Range("B3").Font.Size = 12
...taking out the unneeded recording events and adding in the missing parents.

Anyway, speech over, heh, and the answer to your question is "yes".
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,122,370
Messages
5,595,774
Members
414,018
Latest member
quang118

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
Top