Блог

Я пытаюсь скопировать все ячейки, в которых есть GROUP, и вставить их на другой лист. Пока это мой код. Но я продолжаю получать ошибку 438. Я очень новичок в vba, поэтому буду признателен за любую помощь.

  Sub FindAndExecute()

Dim Sh As Worksheet
Dim Loc As Range

For Each Sh In ThisWorkbook.Worksheets
    With Sh.UsedRange
        Set Loc = .Cells.Find(What:="GROUP*")
        If Not Loc Is Nothing Then
            Do Until Loc Is Nothing
                'Copy the data
                Sheets("Sheet1").Value(Loc).Copy
                'Activate the destination worksheet
                Sheets("Sheet2").Activate
                'Select the target range
                Range("A1").Select
                'Paste in the target destination
                ActiveSheet.Paste
                Set Loc = .FindNext(Loc)
            Loop
        End If
    End With
    Set Loc = Nothing
Next

End Sub
  

Я не могу понять, как вы копируете и вставляете несколько ячеек на новый лист. Вы хотите сохранить исходный шаблон или хотите сохранить его в формате dataset? В любом случае, мое решение — скопировать исходный диапазон на новый лист и очистить ячейки, которые не соответствуют вашим критериям. Я тестировал на своем компьютере.

 Sub Test()

Dim ws As Worksheet
Dim wsa As Worksheet
Dim cll As Range

ThisWorkbook.Sheets.Add

Set wsa = ActiveSheet

lr = 1

For Each ws In ThisWorkbook.Worksheets
    If wsa.CodeName <> ws.CodeName Then
        ws.UsedRange.Copy wsa.Range("A" amp; lr)
        For Each cll In wsa.UsedRange.Cells
            If InStr(1, cll.Value, "Your Criteria String") = 0 Then
                cll.Value = ""
            End If
        Next cll
        lr = lr   ws.UsedRange.Rows.Count
    End If
Next ws

End Sub