Determine Range/Conditions for Copy/Paste Procedure

I need help defining my copy/paste process. I just need an example for the two conditions. The situation is as follows:

I need to search for for specific keywords in a sheet of wb1 and
copy/paste it to wb2 under certain conditions.

I dont know the specific sheet or the position of the keywords, so
every sheet in the wb should be checked

In case a keyword is found - condition 1 or condition 2 will be
applied, depending on the keyword:

Condition 1: if keyword in wb1 = "mx1" then copy/paste keyword to wb2
(specific position -> Sheet2, K7) and rename it to "Male". Result
would be: "Male" in K7 of Sheet2 in wb2.

Condition 2: if keyword in wb1 = "Data 1" then copy the
value(integer) of the adjoining cell to the right of it and paste to
wb2 (specific position -> Sheet3, K3). Result would be: "189" in K7
of Sheet3 in wb2.

A keyword can only have one of the conditions assigned.

Actually, my goal is to have a set of keywords, which have condition
1 or condition 2 assigned, as well as a specific paste-location in
wb2. So, every sheet should be checked according to the set of
keywords.

Example:

https://imgur.com/a/8VCNsrC

Would appreciate any help!

Code so far - only thing I need is condition 1 and 2....

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 2) 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) = "mx1"
arr(2) = "Data 1"
For i = LBound(arr) To UBound(arr)
For Each ws In ThisWorkbook.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
wb2.Sheets("Sheet1").Range("A3").Value = "Male"
Else
wb2.Sheets("Sheet1").Range("B3").Value = rFnd.Offset(0, 1).Value
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)
wbTemplate.SaveAs wbSource.Path & Application.PathSeparator & NewWbName & "_New.xlsx"
wbTemplate.Close False 'close template
Next wsSource

wbSource.Close False 'close source
End Sub


1 Answer
1

You can search a Range for a value, and a range applies to a (part of a) single sheet. So you need to search each worksheet separately. Similarly, you search for a single value, so in this case you need to issue 2 separate searches. I'd do it this way:

Range

Dim rFnd As Range
Dim r1st As Range
Dim ws As Worksheet
Dim arr(1 to 2) As Variant
Dim i as Long

arr(1) = "mx1"
arr(2) = "Data 1"
For i = Lbound(arr) to Ubound(arr)
For Each ws In ThisWorkbook.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
wb2.Sheets("Sheet2").Range("K7").Value = "Male"
Else
wb2.Sheets("Sheet3").Range("K3").Value = rFnd.Offset(0, 1).Value
End If
Set rFnd = ws.UsedRange.FindNext(rFnd)
Loop Until r1st.Address = rFnd.Address
End If
Next
Next


Thanks for contributing an answer to Stack Overflow!

But avoid …

To learn more, see our tips on writing great answers.

Required, but never shown

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service, privacy policy and cookie policy