使用Excel VBA復制特定數據

Question

如果滿足Col和row參數，我將嘗試復制並粘貼某些值

但似乎代碼正在運行，但是輸出上沒有顯示數據

我嘗試了不同的方法，但都沒有成功

Sub SalesDownload()

Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet
Dim vFile As Variant
Dim Channel As String
Dim Month As String
Dim i As Integer, j As Integer
Dim k As Integer, l As Integer



Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = Worksheets("Sales")
'-------------------------------------------------------------
'Open file with data to be copied

vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
"*.xl*", 1, "Select Excel File", "Open", False)

'If Cancel then Exit
If TypeName(vFile) = "Boolean" Then
Exit Sub
Else
Set wbCopyFrom = Workbooks.Open(vFile, ReadOnly:=True)
Set wsCopyFrom = wbCopyFrom.Worksheets("FMS1")
End If

'--------------------------------------------------------------
'Copy Range
'wsCopyFrom.Range("C5:O16").Copy
'wsCopyTo.Range("a1").PasteSpecial Paste:=xlPasteValues, _
'Operation:=xlNone, SkipBlanks:=False, Transpose:=False



For i = 6 To 18



Channel = wsCopyFrom.Cells(i, 3).Value
For j = 4 To 39
Month = wsCopyFrom.Cells(5, j).Value

For k = 2 To 14
For l = 2 To 18
If wsCopyTo.Cells(k, 1).Value = Channel Then
If wsCopyTo.Cells(2, l).Value = Month Then
wsCopyFrom.Activate
wsCopyFrom.Cells(i, j).Value.Copy
wsCopyTo.Activate
wsCopyTo.Cells(k, l).Select.PasteSpecial Paste:=xlPasteValues
End If
End If

Next l
Next k
Next j
Next i

'Close file that was opened
Application.DisplayAlerts = False
wbCopyFrom.Close

MsgBox "Done!!!"


'SaveChanges:=False

End Sub

Answer 1

您是否應該考慮在不使用Excel API的情況下復制數據？ 代替

wsCopyFrom.Activate
wsCopyFrom.Cells(i, j).Value.Copy
wsCopyTo.Activate
wsCopyTo.Cells(k, l).Select.PasteSpecial Paste:=xlPasteValues

使用變量，例如：

set value = wsCopyFrom.Cells(i, j).Value
wsCopyTo.Cells(k, l).Value = value;

它會更快，並且不會依賴excel UI。