需要在工作簿上复制某些数据

这里是新的VBA。 我一直在这个问题上停留了一段时间：

从本质上讲，我需要创build一个macros，将特定的数据从一张表复制到另一张表，由用户指定。 值得注意的是，虽然所有的数据都在一列（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 

随后，我将不得不匹配数据，这些已被复制的条目，但我想我得到了如何做迭代东西的hang它应该不是太多的问题。 但现在我真的卡住了…请帮助！

Answer 1

它看起来应该工作，除了那部分：

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

第三行包含一个未知variables： 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