需要通过工作簿复制某些数据

时间:2014-04-21 15:26:14

标签: excel vba excel-vba

这里是VBA新手。我现在已经坚持这个问题一段时间了:

基本上,我需要创建一个宏,将特定数据从一个工作表复制到另一个工作表,这取决于用户指定。问题在于,虽然所有数据都在一列(B)中,但并非列的所有行都有相关条目;有些是空白的,有些还有其他我不想要的数据。

只需要以4个数字开头的条目。我似乎无法了解迭代复制粘贴的工作原理;我提出的内容如下:

'defining input

Dim dater As Date
dater = Range("B2")
If dater = False Then
    MsgBox "Date not specified"
         Exit Sub
End If

Dim sheetin As String
sheetin = Range("B5")
  If sheetin = "" Then
    MsgBox "Input Sheet not specified"
         Exit Sub
End If

Dim wbin As String
wbin = Range("B4")
  If wbin = "" Then
    MsgBox "Input workbook not specified"
         Exit Sub
End If

Dim sheetout As String
sheetout = Range("B9")
  If sheetout = "" Then
    MsgBox "Output Sheet not specified"
         Exit Sub
End If

Dim wbout As String
wbout = Range("B8")
  If wbout = "" Then
    MsgBox "Output Workbook not specified"
         Exit Sub
End If

Windows(wbout).Activate
Dim sh As Worksheet, existx As Boolean
For Each sh In Worksheets
If sh.Name Like sheetout Then existx = True: Exit For
Next
If existx = True Then
If Sheets(sheetout).Visible = False Then Sheets(sheetout).Visible = True
Else
Sheets.Add.Name = CStr(sheetout)


End If


'copy pasting values


Windows(wbin).Activate
Sheets(sheetin).Select
'specify maximum row
iMaxRow = 500
For iRow = 1 To iMaxRow


With Worksheets(sheetin).Cells(iRow, 2)
    'Check that cell is not empty.
    If .Value = "####*" Then
       .Copy Destination:=Workbooks(wbout).Worksheets(sheetout).Range("A" & i)
        'Else do nothing.
    End If
End With

Next iRow

End Sub

随后我必须将数据与已经复制过的这些条目进行匹配,但是我知道如果我知道如何处理迭代的东西,它不应该是一个太大的问题。但是现在我真的卡住了......请帮忙!

1 个答案:

答案 0 :(得分:2)

它看起来应该有效,除了那部分:

With Worksheets(sheetin).Cells(iRow, 2)
    If .Value = "####*" Then
       .Copy Destination:=Workbooks(wbout).Worksheets(sheetout).Range("A" & i)
    End If
End With

第三行包含一个未知变量:i

您需要将其定义为包含要复制的行号。例如,如果要复制到第一个可用行,请尝试以下操作:

Set wsOut = Workbooks(wbout).Worksheets(sheetout)
With Worksheets(sheetin).Cells(iRow, 2)
    If .Value = "####*" Then
       i = wsOut.Cells(wsOut.Rows.Count, 1).End(xlUp).Row + 1
       .Copy Destination:=wsOut.Range("A" & i)
    End If
End With