如果满足 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