Мне нужно скопировать данные строки строки столбца C & D рабочей книги 1 в рабочую книгу 2 листа 3, но есть ошибка.

Sub Copy_Paste()
  Dim Openfile As String ' Openfile
  Dim lstrow As Long
  Dim i As Long
  lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
  Application.ScreenUpdating = False
  For i = 2 To lstrow
 'Copy the data
    ThisWorkbook.Sheets("Main").range("C:D", i).Copy
 'Activate the destination worksheet
    Workbooks.Open Filename:=range("H", i)
      Sheets("Sheet3").Activate
  'Select the target range
  range("B2:C2").Select
   'Paste in the target destination
     ActiveSheet.PasteSpecial xlPasteValues

     Application.CutCopyMode = False
     ThisWorkbook.Close SaveChanges:=True
  Next
End Sub

1 ответ1

0

Вы должны действительно попытаться избежать активации и выбрать в своем коде. Кроме того, в настоящее время есть некоторые вещи, которые бесполезны или не имеют смысла. Дайте это попробовать. В случае ошибки убедитесь, что strFileName - это полный путь к книге, а не только имя файла (для получения дополнительной информации см. Здесь ):

Option Explicit

Sub Copy_Paste()
  Application.ScreenUpdating = False

  Dim wb As Workbook, wbPaste As Workbook
  Dim ws As Worksheet, wsPaste As Worksheet
  Dim strFileName As String
  Dim lstrow As Long, i As Long


  Set wb = ThisWorkbook
  Set ws = wb.Sheets("Main")

  lstrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

  For i = 2 To lstrow

    'Set data to copy
      Set CopyRange = ws.Range(ws.Cells(i, 3), ws.Cells(i, 4))
    ' Set PasteRange
      strFileName = ws.Range("H", i).Value
      'Open workbook in which you want to paste
      Set wbPaste = Workbooks.Open(strFileName)
      'Define the worksheet
      Set wsPaste = wbPaste.Sheets("Sheet3")
      'Paste
      wsPaste.Range(wsPaste.Cells(2, 2), wsPaste.Cells(2, 3)).Value = CopyRange.Value
    Next i

  Application.ScreenUpdating = True
End Sub

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .