Macro to find specific text in column and copy certain cells in same row to different Workbook

[gjiaxin1989]

Hi,

I am trying to write a macro sub that searches for a certain string in column X and copy the values in column I and K on the same row onto another workbook. Values from I will be copied to cell B15 in the new workbook, and values from K will be pasted to cell D15. The next matching values will be pasted at B16, D16, and so on.... I have read jlevesquire's thread http://www.mrexcel.com/forum/excel-...y-certain-cells-same-row-different-sheet.html. I think what I'm looking for is very similar to what he wanted. However, after editing his code to meet mine, it is not working. Especially the Offset(1) part. It says that its missing a "=". Can someone please help me? Here is my code:

Sub CommandButton1_Click()


Dim wsSource As Worksheet
Dim wbSource As Workbook
Dim wsTarget As Worksheet
Dim wbTarget As Workbook
Dim findRange As Range
Dim newForm As Workbook
Dim J As Integer


Application.ScreenUpdating = False


Set wbSource = ThisWorkbook


Set wsSource = wbSource.Sheets(1)


Set wbTarget = Workbooks.Open("C:\FilePath")
Set wsTarget = wbTarget.Sheets(1)
wsTarget.Activate


Set findRange = wsTarget.Range("A1:H11")
findRange.Replace What:="xxx-Project.No", Replacement:=wsSource.Range("s5:w5").Value, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False


ActiveWorkbook.SaveCopyAs Filename:="C:\FilePath_NEW"
ActiveWorkbook.Close False
Set newForm = Workbooks.Open("C:\FilePath_New")


J = 1
Dim setrng As Range
Set setrng = wsSource.Columns("X:X")


setrng.AutoFilter Field:=1, Criteria1:="Y"
wsSource.Range(wsSource.Range("I9").Offset(1), wsSource.Range("I9").End(xlDown)).Copy_
newForm.Range("B" & Rows.Count).End(xlUp).Offset (1)
wsSource.Range(wsSource.Range("K9").Offset(1), wsSource.Range("K9").End(xlDown)).Copy_
newForm.Range("D" & Rows.Count).End(xlUp).Offset (1)


End Sub

And can someone show me how to upload my spreadsheet? I am new to this forum... Thanks a million

Natalie

 

[L. Howard]

Try this. Note the RED text in the code reflects correctly to your copy FROM sheet name and the copy TO workbook name.

Regards,
Howard

Option Explicit

Sub Find_First()
  Dim FindString As String '
  Dim Rng As Range '
  'Dim i As Long
  Dim RngI As String
  Dim RngK As String
  Dim LRow As Range
  
  FindString = InputBox("Enter a Search value")
   If Trim(FindString) <> "" Then
     With Sheets("[COLOR=#ff0000]Sheet1[/COLOR]").Range("A1:H11")
       Set Rng = .Find(What:=FindString, _
          After:=.Cells(.Cells.Count), _
          LookIn:=xlValues, _
          LookAt:=xlWhole, _
          SearchOrder:=xlByRows, _
          SearchDirection:=xlNext, _
          MatchCase:=False)
          
       If Not Rng Is Nothing Then
             RngI = .Cells(Rng.Row, "I")
             RngK = .Cells(Rng.Row, "K")
           With Workbooks("[COLOR=#ff0000]Book3[/COLOR]").Sheets("Sheet1")
              Set LRow = .Cells(.Rows.Count, "B").End(xlUp)(2)
              LRow = RngI
              LRow.Offset(, 2) = RngK
           End With
         Else
           MsgBox "Nothing found"
       End If
       
     End With
   End If
        
End Sub

[/code

 

[gjiaxin1989]

Hi Howard,

Thank you for the code However I was actually only having trouble with the 2nd part of the code. Is there any ways to find a string in column X, and copy value from column I (same row as the string was found in column X) to B in another worksheet, and copy value from column K to D in another worksheet??

Thank for the help! Below is the part of the code I am struggling with


Dim setrng As RangeSet setrng = wsSource.Columns("X:X")setrng.AutoFilter Field:=1, Criteria1:="Y"wsSource.Range(wsSource.Range("I9").Offset(1), wsSource.Range("I9").End(xlDown)).Copy_newForm.Range("B" & Rows.Count).End(xlUp).Offset (1)wsSource.Range(wsSource.Range("K9").Offset(1), wsSource.Range("K9").End(xlDown)).Copy_newFrm.Range("D" & Rows.Count).End(xlUp).Offset (1)</pre>

 

[L. Howard]

Your original post says you want to copy to another WORKBOOK.

I am trying to write a macro sub that searches for a certain string in column X and copy the values in column I and K on the same row onto another workbook. Values from I will be copied to cell B15 in the new workbook,

Do you want to copy to another sheet in the SAME workbook?
If so, what is the name of that sheet?

I am assuming column(XX) is the column that the find value happens to be within the find range(a1:h11).

Howard

 

[gjiaxin1989]

Hi Howard,

Thanks for your help! I am usually really bad at explaining myself to other people.....what I needed was the create a separate file from the original form, and save as, and do more searching, copying and pasting once the new file is saved. I wanted to copy and paste cells in I and K to B and D into the new file when string"Y" is found in column X. After some struggling, my code is working now! Here are my code, for people who come across the same problem in the future.

Sub CommandButton1_Click()


Dim wsSource As Worksheet
Dim wbSource As Workbook
Dim wsTarget As Worksheet
Dim wbTarget As Workbook
Dim findRange As Range
Dim newForm As Workbook
Dim newFromws As Worksheet
Dim lastline As Integer


Set wbSource = ThisWorkbook


Set wsSource = wbSource.Sheets(1)


Set wbTarget = Workbooks.Open("C:\FilePath\.xls")
Set wsTarget = wbTarget.Sheets(1)
wsTarget.Activate


Set findRange = wsTarget.Range("A1:I9")
findRange.Replace What:="xxx-string", Replacement:=wsSource.Range("s5:w5").Value, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False


ActiveWorkbook.SaveCopyAs Filename:="C:\newFilePath\1.xls"
ActiveWorkbook.Close False
Set newForm = Workbooks.Open("C:\newFilePath\1.xls")
Set newFormws = newForm.Sheets(1)




lastline = Range("X65536").End(xlUp).Row


Dim d As Integer


Dim j As Integer


d = 10
j = 9
For i = 1 To lastline


If wsSource.Range("X" & j) = "Y" Then
d = d + 1


newFormws.Range("B" & d).Value = wsSource.Range("I" & j).Value
newFormws.Range("D" & d).Value = wsSource.Range("K" & j).Value


End If
j = j + 1
Next i
newForm.Save
Set wsSource = Nothing
Set wsTarget = Nothing
Set newFormws = Nothing












End Sub

 

[L. Howard]

Good. Glad you got it going.

Regards,
Howard

 

[abdullahsikandar]

Hi,

Thanks is there any way that we search for some columns and paste it in the same sheet, for example: macro will lookup for column A,B,C and D and if it found that then it will paste it towards the end of the sheet.

 

[L. Howard]

Yes, that is quite common.

What is it you want to look up in the columns and where is "...towards the end of the sheet."?

Regards,
Howard

 

[abdullahsikandar]

Yes, that is quite common.

What is it you want to look up in the columns and where is "...towards the end of the sheet."?

Regards,
Howard

Actually, I want to copy the whole column with the heading and paste it in the last.

Well i have columns till "BV" so i need it after that i mean on BX. what i need is to copy Column A,B,C and D and the data in the whole column to be copied in the last.

Thanks alot.
Let me know if you need anymore information.

 

[L. Howard]

You say last column is BV and you want copies to BX, so the code below puts a blank column between the last and the copied columns.
If you want NO blank column, then change Cells(1, Lc + 2) to Cells(1, Lc + 1).

Regards,
Howard

Option Explicit

Sub adRange()
Dim Lc As Long

Lc = Cells.Find(what:="*", After:=[A1], _
                SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious).Column
                
 Range("A:D").Copy Cells(1, Lc + 2)
End Sub