Loop through list of filenames and corresponding sheet names

[Diffus]

This ought to be pretty easy.

I'm looking to speed up the execution of this code:

Sheets("Storage").Select
Range("StartHere").Select

Do Until ActiveCell.Value = ""
fnm = ActiveCell.Value
snm = ActiveCell.Offset(0, 1).Value
Workbooks(Currfile).Worksheets(snm).UsedRange.Clear
Workbooks.Open Filename:=Range("Input_folder").Value & "\" & fnm & ".xlsx"

With Range("A1").CurrentRegion
.WrapText = False
.ShrinkToFit = False
.UnMerge
End With
Workbooks(fnm).Worksheets("Sheet").UsedRange.Copy Workbooks(Currfile).Worksheets(snm).Range("A1")
Workbooks(fnm).Close SaveChanges:=False
Sheets("Storage").Select
ActiveCell.Offset(1, 0).Select
Loop

It loops through a list in a workbook tab, with a filename in column A and a corresponding sheetname in column B, copying the contents of the file to the corresponding sheet. I know there ought to be a way to read the names into an array and pull them from there, rather than selecting them from worksheet cells, but I don't have any experience in doing that, and I am looking to learn.

Thanks in advance.

 

[johnnyL]

@6StringJazzer I did indeed. I was just going to see if there was anything else that could be done.

 

[johnnyL]

Ok, here is what I came up with. Untested by me, but I think it should work.

Sub Test()
'
    Dim File_Sheet_Counter  As Long
    Dim InputFolderPath     As String
    Dim fnm                 As String                                                       ' Source file name ... Column A
    Dim snm                 As String                                                       ' Destination sheet name ... Column B
    Dim File_Sheet_Array    As Variant
    Dim wsInfoSource        As Worksheet
'
    Set wsInfoSource = Sheets("Storage")                                                    ' <--- Set this to the sheet name that has the info of files & sheets
    InputFolderPath = wsInfoSource.Range("Input_folder").Value                              ' Save path to files into InputFolderPath
'
    File_Sheet_Array = wsInfoSource.Range("StartHere:B" & Range("A" & Rows.Count).End(xlUp).Row)    ' Load file names & sheeet names into 2D 1 based array RC
'
    For File_Sheet_Counter = LBound(File_Sheet_Array) To UBound(File_Sheet_Array)           ' Establish loop to loop through the file and sheet names
        fnm = File_Sheet_Array(File_Sheet_Counter, 1)                                       '   Save file name into fnm
        snm = File_Sheet_Array(File_Sheet_Counter, 2)                                       '   Save sheet name into snm
'
        ThisWorkbook.Sheets(snm).UsedRange.Clear                                            '   Clear the data from the sheet about to be written to
        Workbooks.Open FileName:=InputFolderPath & "\" & fnm & ".xlsx"                      '   Open File
'
        With Range("A1").CurrentRegion                                                      '   unwrap, unshrink, unmerge sheet that will be copied
            .WrapText = False
            .ShrinkToFit = False
            .UnMerge
        End With
'
        Workbooks(fnm).Sheets("Sheet").UsedRange.Copy ThisWorkbook.Sheets(snm).Range("A1")  ' Copy sheet from opened file to destination sheet
        Workbooks(fnm).Close SaveChanges:=False                                             ' Close opened File without saving
    Next
End Sub

 

[Diffus]

Did you see post #2?

Yes, I did, thanks. I got caught up in the back-and-forth with JohnnyL. Checking out the suggestions therein is on my TDL. Thanks again.