hobbiton73
03-24-2013, 11:17 AM
Hi, I wonder whether someone may be able to help me please.
I'm using the code below to consoldiate multiple Excel workbooks into one 'Summary' sheet.
Sub Merge()
Dim DestWB As Workbook
Dim WB As Workbook
Dim ws As Worksheet
Dim SourceSheet As String
Dim startRow As Long
Dim n As Long
Dim dr As Long
Dim lastRow As Long
Dim FileNames As Variant
Sheets("Input").Range("A7:AE1700").Cells.ClearContents
Set DestWB = ActiveWorkbook
SourceSheet = "Input"
startRow = 7
Application.ScreenUpdating = False
Set WB = ThisWorkbook
FileNames = WB.Worksheets("Lists").Range("B3:B22").Value
For n = LBound(FileNames, 1) To UBound(FileNames, 1)
Set WB = Workbooks.Open(Filename:=FileNames(n, 1), ReadOnly:=True)
For Each ws In WB.Worksheets
Call ShowProgress
If ws.Name = SourceSheet Then
With ws
If .UsedRange.Cells.Count > 1 Then
dr = DestWB.Worksheets("Input").Range("C" & DestWB.Worksheets("Input").Rows.Count).End(xlUp).Row + 1
lastRow = .Range("C" & Rows.Count).End(xlUp).Row
If lastRow >= startRow Then
.Range("A" & startRow & ":AE" & lastRow).Copy
DestWB.Worksheets("Input").Cells(dr, "A").PasteSpecial xlValues
End If
End If
End With
Exit For
End If
Next ws
Application.CutCopyMode = False
WB.Close savechanges:=False
Next n
Columns("A:S").EntireColumn.AutoFit
End Sub
Using this line, FileNames = WB.Worksheets("Lists").Range("B3:B22").Value the script runs through a list of files opening each one and copying the relevant information before pasting into the 'Destination' file.
The problem I have is that all of the 'Source' files are password protected and because there are approximately 20 of these, to run through each one is quite a laborious task.
I've not been able to find any examples of this, so I'm not sure whether it's possible, but could someone perhaps offer some guidance on how I may be able to adapt the code, so that the script looks through the list in the range "B3:B22" as per the current functionality, but then looks through "C3:C22" for the relevant password.
Any help would be gratefully received.
Many thanks and kind regards
Chris
I'm using the code below to consoldiate multiple Excel workbooks into one 'Summary' sheet.
Sub Merge()
Dim DestWB As Workbook
Dim WB As Workbook
Dim ws As Worksheet
Dim SourceSheet As String
Dim startRow As Long
Dim n As Long
Dim dr As Long
Dim lastRow As Long
Dim FileNames As Variant
Sheets("Input").Range("A7:AE1700").Cells.ClearContents
Set DestWB = ActiveWorkbook
SourceSheet = "Input"
startRow = 7
Application.ScreenUpdating = False
Set WB = ThisWorkbook
FileNames = WB.Worksheets("Lists").Range("B3:B22").Value
For n = LBound(FileNames, 1) To UBound(FileNames, 1)
Set WB = Workbooks.Open(Filename:=FileNames(n, 1), ReadOnly:=True)
For Each ws In WB.Worksheets
Call ShowProgress
If ws.Name = SourceSheet Then
With ws
If .UsedRange.Cells.Count > 1 Then
dr = DestWB.Worksheets("Input").Range("C" & DestWB.Worksheets("Input").Rows.Count).End(xlUp).Row + 1
lastRow = .Range("C" & Rows.Count).End(xlUp).Row
If lastRow >= startRow Then
.Range("A" & startRow & ":AE" & lastRow).Copy
DestWB.Worksheets("Input").Cells(dr, "A").PasteSpecial xlValues
End If
End If
End With
Exit For
End If
Next ws
Application.CutCopyMode = False
WB.Close savechanges:=False
Next n
Columns("A:S").EntireColumn.AutoFit
End Sub
Using this line, FileNames = WB.Worksheets("Lists").Range("B3:B22").Value the script runs through a list of files opening each one and copying the relevant information before pasting into the 'Destination' file.
The problem I have is that all of the 'Source' files are password protected and because there are approximately 20 of these, to run through each one is quite a laborious task.
I've not been able to find any examples of this, so I'm not sure whether it's possible, but could someone perhaps offer some guidance on how I may be able to adapt the code, so that the script looks through the list in the range "B3:B22" as per the current functionality, but then looks through "C3:C22" for the relevant password.
Any help would be gratefully received.
Many thanks and kind regards
Chris