Home » excel » excel – Determine Range/Conditions for Copy/Paste Procedure

excel – Determine Range/Conditions for Copy/Paste Procedure

Posted by: admin May 14, 2020 Leave a comment

Questions:

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
How to&Answers:

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:

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