Найти конкретные данные и скопировать содержимое до конца строки

Question

Я сохранил два отчета Excel EPC1.xlsx и Control Power Transformers.xlsm соответственно.

Я хочу, чтобы вызвать нажатие кнопки из Control Power Transformers.xlsm отчета, где он будет искать "CTPT" термина в колонке «А» из EPC1.xlsx после того, как он находит термин его нужно скопировать столбец B и столбец С до концов строк (в EPC1.xlsx) и вставьте его в Control Power Transformers.xlsm workbook

Мне удастся получить адрес ячейки термина «CTPT», но как выбрать данные из соседних столбцов B и C?

И это то, что я попытался

Private Sub CommandButton23_Click() 
Dim rngX As Range 
Dim num As String 

Windows("EPC 1.xlsx").Activate 
Set rngX = Worksheets("Sheet1").Range("A1:A10000").Find("CTPT", Lookat:=xlPart) 
num = rngX.Address ' Here we will the get the cell address of CTPT ($A$14) 
Range(rngX, Range("C" & rngX.Row).End(xlDown)).Copy 
Windows("Control Power Transformers.xlsm").Activate 
Sheets("Sheet2").Select 
ActiveSheet.Range("E2").PasteSpecial (xlPasteValues) 


End Sub 

Answer 1

Вы должны использовать FindNext, чтобы найти другие результаты, а Offset поможет вам выбрать то, что вы хотите от адреса ваших результатов:

Sub test_Karthik() 
Dim WbEPC As Workbook, _ 
    WbCPT As Workbook, _ 
    WsEPC As Worksheet, _ 
    WsCPT As Worksheet, _ 
    FirstAddress As String, _ 
    WriteRow As Long, _ 
    cF As Range, _ 
    num As String 

Set WbEPC = Workbooks("EPC 1.xlsx") 
Set WbCPT = Workbooks("Control Power Transformers.xlsm") 
Set WsEPC = WbEPC.Sheets("Sheet1") 
Set WsCPT = WbCPT.Sheets("Sheet2") 

With WsEPC 
    .Activate 
    With .Range("A1:A10000") 
    'First, define properly the Find method 
     Set cF = .Find(What:="CTPT", _ 
        After:=ActiveCell, _ 
        LookIn:=xlValues, _ 
        Lookat:=xlPart, _ 
        SearchOrder:=xlByColumns, _ 
        SearchDirection:=xlNext, _ 
        MatchCase:=False, _ 
        SearchFormat:=False) 

     'If there is a result, keep looking with FindNext method 
     If Not cF Is Nothing Then 
      FirstAddress = cF.Address 
      Do 
       num = cF.Address ' Here we will the get the cell address of CTPT ($A$14) 
       WsEPC.Range(cF.Offset(0, 1), cF.Offset(0, 2).End(xlDown)).Copy 
       WriteRow = WsCPT.Range("E" & WsCPT.Rows.count).End(xlUp).Row + 1 
       WsCPT.Range("E" & WriteRow).PasteSpecial (xlPasteValues) 

       Set cF = .FindNext(cF) 
      'Look until you find again the first result 
      Loop While Not cF Is Nothing And cF.Address <> FirstAddress 
     End If 
    End With 
End With 

End Sub 

Answer 2

Вставить ниже в образце книги. Нижеприведенный код поможет выбрать оба файла, используя диалог файла. Он будет искать слово «CTPT». если это так, он скопирует значения столбцов из листа CTPT в управляющий файл.

Sub DetailsFilePath() 

Dim File1 As String 
Dim File2 As String 
Dim findtext As String 
Dim copyvalues As Long 
Dim c As Variant 

Dim wb1 As Workbook 
Dim wb2 As Workbook 
Dim ws1 As Worksheet 
Dim ws2 As Worksheet 

MsgBox "Open the CTPT file" 

Application.FileDialog(msoFileDialogFilePicker).Show 


'On Error Resume Next 

' open the file 

File1 = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1) 

MsgBox "Open the Control Power Transformers file" 


Application.FileDialog(msoFileDialogFilePicker).Show 

File2 = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1) 




Set wb1 = Workbooks.Open(Filename:=File1) 
Set ws1 = wb1.Worksheets("sheet1") 


Set wb2 = Workbooks.Open(Filename:=File2) 
Set ws2 = wb2.Worksheets("sheet1") 




findtext = "CTPT" 

    With ws1.Columns(1) 
     Set c = .Find(findtext, LookIn:=xlValues) 
      If Not c Is Nothing Then 
       copyvalues = c.Column 
      ws2.Columns(2).Value = ws1.Columns(2).Value 
      ws2.Columns(3).Value = ws1.Columns(3).Value 


      End If 
    End With 


wb1.Close savechanges:=True 
wb2.Close savechanges:=True 



End Sub