Импорт значений диапазона данных - но не пустых ячеек и / или сохранение формул в целевой книге

Question

У меня есть рабочая книга источника и рабочая книга назначения. Исходная книга имеет диапазон (D13:F293), который содержит значения данных, а также пустые ячейки. Книга назначения содержит одинаковый диапазон, а различные ячейки содержат формулы.

Я хочу импортировать данные из исходной книги в книгу назначения, но ТОЛЬКО в ячейки, содержащие значение. Кроме того, если книга / ячейка назначения содержит формулу, я хочу СОХРАНИТЬ формулу в ячейке.

Мои варианты:

1. Сканирование источника на наличие пустых ячеек и импорт только ячеек с данными.
2. Сканирование получателя для формул, и, если формулы существуют, не импортируйте данные в эту ячейку.

Я не знаю, как это сделать. Я очень плохо знаком с VBA и не до конца понимаю синтаксис. Я пробовал 3 раза с кодом, который либо заменяет формулы пустыми ячейками, либо выдает ошибку.

Этот код копирует пустые ячейки в книгу назначения:

Sub TransferData()
   If Workbooks.Count > 1 Then
      Workbooks(2).Sheets("HELOC").Range("D13:F293").Copy
      Workbooks(1).Sheets("HELOC").Range("D13:F293").PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Workbooks(2).Close savechanges:=False
   Else
      MsgBox "The data hasn't been transferred.", vbExclamation, "Error"
   End If
End Sub

Этот код также копирует пустые ячейки в книгу назначения:

Sub TransferData()
   If Workbooks.Count > 1 Then
      For Each cl In ActiveSheet.UsedRange
         If cl.HasFormula() = True Then
            Workbooks(1).Sheets("HELOC").Range("D13:F293") = Workbooks(1).Sheets("HELOC").Range("D13:F293")
         Else
            Workbooks(1).Sheets("HELOC").Range("D13:F293").Value = Workbooks(2).Sheets("HELOC").Range("D13:F293").Value
         End If
      Next cl
      Workbooks(2).Close savechanges:=False
   Else
      MsgBox "The data hasn’t been transferred.", vbExclamation, "Error"
   End If
End Sub

Этот код (измененный с здесь ) приводит к:

Ошибка выполнения 91 Переменная объекта или с переменной блока, не установленной в строке:

"Если mySourceBook.Cells (i, 1). Value <>" "Then"

Sub TransferData()
   Dim mySourceBook As Worksheet, myDestinationBook As Worksheet, myBook As Workbook
   Set myBook = Excel.ActiveWorkbook
   Set mySource = myBook.Sheets("HELOC")
   Set myImportData = Excel.ActiveWorkbook.Sheets("HELOC")

   Dim i As Integer, j As Integer 'Define a couple integer variables for counting

   j = 13
   For i = 13 To 293
      If mySourceBook.Cells(i, 1).Value <> "" Then
         myDestinationBook.Cells(j, 2).Value = mySourceBook.Cells(i, 1).Value
         j = j + 1
      End If
   Next i 'This triggers the end of the loop and moves on to the next value of "i".

   Workbooks(2).Close savechanges:=False

   MsgBox "The data hasn’t been transferred.", vbExclamation, "Error"

End Sub

Я ценю любые советы. Но, пожалуйста, объясни мне это, как будто я ребенок, так как я не до конца понимаю VBA.

Answer 1

Я получил его на работу, как я хочу!Большое спасибо за помощь, Тим!

Теперь, чтобы выяснить, как импортировать и сохранить формат.

Sub TransferData()

Dim rngSrc As Range, rngDest As Range, i As Long, cS As Range, cD As Range

Set rngSrc = Workbooks("Exported AMP Data.xlsx").Worksheets("HELOC").Range("D13:F293")
Set rngDest = Workbooks(1).Worksheets("HELOC").Range("D13:F293")

For i = 1 To rngSrc.Cells.Count
    Set cS = rngSrc.Cells(i)
    Set cD = rngDest.Cells(i)
    If Len(cS.Value) > 0 Then
        cS.Copy cD
        'or
        cD.Value = cD.Value
    End If
Next i
End If
End Sub

Answer 2

Вы можете сделать это так:

Sub MoveIt()

    Dim rngSrc As Range, rngDest As Range, i As Long, cS As Range, cD As Range

    Set rngSrc = Workbooks("Source.xlsx").Worksheets("Sheet1").Range("D13:F293")
    Set rngDest = Workbooks("Target.xlsx").Worksheets("Sheet4").Range("D13:F293")

    For i = 1 To rngSrc.Cells.Count
        Set cS = rngSrc.Cells(i)
        Set cD = rngDest.Cells(i)
        If Len(cS.Value) > 0 And Not cD.HasFormula Then
            cS.Copy cD
            'or
            cD.Value = cS.Value
        End If
    Next i

End Sub