Copy specific cells in multiple protected files to summary workbook

[anj123]

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!

 

[jbeaucaire]

I'm thinking this should work once you edit the name of the wsDEST:

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]

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]

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:

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:

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:

    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:

    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".

 

[anj123]

That makes sense - thanks for the tips!