使用多个条件复制和粘贴数据

时间:2017-01-24 19:01:46

标签: vba

我是VBA的新手,我有以下代码将数据从一张纸复制到另一张,但它不起作用......

Option Explicit

Sub CopyRows()
Dim Cl As Range
Dim Range1 As Range
Dim Range2 As Range
Dim str As String
Dim RowUpdCrnt As Long
Dim Sheets As Worksheet
Dim Lmonth As Integer
Dim MyObject As Object
Dim MyObject2 As Object
Dim MyObject3 As Object

Set MyObject = Sheets("Master")
Set MyObject2 = Sheets("Jan").Range("AN5:AN81")
Set MyObject3 = Sheets("Feb").Range("I5:AK5")

str = "WRK.*" 'string to look for

Lmonth = Month("12/31/2017")

RowUpdCrnt = 5

' In my test data, the "WRK."s are in column AN.  This For-Each only selects column AN.
' I assume all my "WRK."s are in a single column.  Replace "B" by the appropriate
' column letter for your data

If MyObject3 <> "" And MyObject2.Value = str Then
  Application.vlookp(Sheets("Jan").Range("b5:B81"),      Sheets("Master").Range("H7:Q200"), 1, 0).Copy
  Sheets("Feb").Range("B5:B81").Paste
End If
With Sheets("Feb")
  For Each Cl In .Range("b1:b" & .Cells(.Rows.Count, "b").End(xlDown).Row + 1)
    If Cl.Value = "" Then
      Sheets("Feb").Range("B5:B81").End(xlDown).Row 1 =    Application.lookup(Sheets("Master").Range("o7:o200").Value)
    End If
  Next Cl
Application.CutCopyMode = False
End With
End Sub

0 个答案:

没有答案