Expected situation: I have a loop which is checking all sheets of a workbook for certain keywords, copy/pasting them according to certain conditions and ist creating a new workbook for every sheet with the said values.
Example:
Source Workbook with Sheet1,Sheet2 and Sheet3 ---> New_Workbook_1(with values of Sheet1), New_Workbook_2(with values of Sheet2), New_Workbook_3(with values of Sheet3)
Actual situation: only the values of the last sheet of the workbook are pasted into the newly created workbooks...I can't tell why? .
Example:
Source Workbook with Sheet1,Sheet2 and Sheet3 ---> New_Workbook_1(with values of Sheet3), New_Workbook_2(with values of Sheet3), New_Workbook_3(with values of Sheet3)
Public Sub TransferFile(TemplateFile As String, SourceFile As String)
Dim wbSource As Workbook
Set wbSource = Workbooks.Open(SourceFile) 'open source
Dim rFnd As Range
Dim r1st As Range
Dim ws As Worksheet
Dim arr(1 To 4) As Variant
Dim i As Long
Dim wbTemplate As Workbook
Dim NewWbName As String
Dim wsSource As Worksheet
For Each wsSource In wbSource.Worksheets 'loop through all worksheets in source workbook
Set wbTemplate = Workbooks.Open(TemplateFile) 'open new template
'/* Definition of the value range */
arr(1) = "XX"
arr(2) = "Data 2"
arr(3) = "Test 3"
arr(4) = "XP35"
For i = LBound(arr) To UBound(arr)
For Each ws In wbSource.Worksheets
Debug.Print ws.Name
Set rFnd = ws.UsedRange.Find(what:=arr(i), LookIn:=xlValues, lookat:=xlPart, SearchOrder:=xlRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not rFnd Is Nothing Then
Set r1st = rFnd
Do
If i = 1 Then
wbTemplate.Sheets("Header").Range("A3").Value = "XX"
ElseIf i = 2 Then
wbTemplate.Sheets("Header").Range("B9").Value = rFnd.Offset(0, 1).Value
ElseIf i = 3 Then
wbTemplate.Sheets("Header").Range("D7").Value = rFnd.Offset(0, 2).Value
ElseIf i = 4 Then
wbTemplate.Sheets("MM1").Range("A8").Value = "2"
End If
Set rFnd = ws.UsedRange.FindNext(rFnd)
Loop Until r1st.Address = rFnd.Address
End If
Next
Next
NewWbName = Left(wbSource.Name, InStr(wbSource.Name, ".") - 1)
For i = 1 To 9
'check for existence of proposed filename
If Len(Dir(wbSource.Path & Application.PathSeparator & NewWbName & "_V" & i & ".xlsx")) = 0 Then
wbTemplate.SaveAs wbSource.Path & Application.PathSeparator & NewWbName & "_V" & i & ".xlsx"
Exit For
End If
Next i
wbTemplate.Close False 'close template
Next wsSource
wbSource.Close False 'close source
End Sub
