0

I'm trying to get a macro in Excel working.

Right now I have a worksheet called "Forms" with 3 columns - the headings (in row 1) are A = Form Number, B = Form Name, C = Parts I also have a worksheet called Ins, which has the same exact headings and is populated with the information already.

I'm trying to get it so that I can enter in the form numbers on "Forms" in column A and have the information from Ins automatically copy over for columns B and C. I have EntireRow in the code right now, but I would prefer it if I could have it specifically only copy to column A to C, but I can't think of how.

Here is the code I'm currently trying to use:

Private Sub Auto()

Application.ScreenUpdating = False
Dim wks1 As Worksheet, wks2 As Worksheet

Dim j As Integer
Dim i As Integer

Set wks1 = Sheets("Forms")
Set wks2 = Sheets("Ins")

lastline = wks1.UsedRange.Rows.Count

For i = 2 To lastline

wks2.Cells(1, 1).CurrentRegion.AutoFilter
wks2.Cells(1, 1).CurrentRegion.AutoFilter 1, wks1.Cells(i, 1).Value
wks2.Cells(1, 1).CurrentRegion.EntireRow.Copy wks1.Cells(i, 1)
wks2.Cells(1, 1).CurrentRegion.AutoFilter


Next i


End Sub
4

3 回答 3

0

我最终通过添加第三个工作簿并在 A 列中输入表格编号来完成这项工作！

Private Sub Auto()

Application.ScreenUpdating = False
Dim wks1 As Worksheet, wks2 As Worksheet

Dim j As Integer
Dim i As Integer

Set wks1 = Sheets("Form Worksheet")
Set wks2 = Sheets("Instructions")
Set wks3 = Sheets("To Do")

lastline = wks1.UsedRange.Rows.Count

For i = 2 To lastline

wks2.Cells(2, 1).CurrentRegion.AutoFilter
wks2.Cells(2, 1).CurrentRegion.AutoFilter 1, wks3.Cells(i, 1).Value
wks2.Cells(2, 1).CurrentRegion.Offset(1).Resize(, 10).Copy
wks1.Cells(i, 4).PasteSpecial Paste:=xlPasteValues
wks2.Cells(2, 1).CurrentRegion.AutoFilter


Next i


End Sub

但我最终使用了蒂姆的版本。

多谢你们！

于 2013-09-26T03:15:23.940 回答
0 
wks2.Cells(1, 1).CurrentRegion.Resize(,3).Copy wks1.Cells(i, 1)

编辑：我认为这样的事情会更好

Private Sub Auto()

Application.ScreenUpdating = False
Dim wks1 As Worksheet, wks2 As Worksheet
Dim f As Range, frmNum
Dim lastLine As Long

Dim j As Integer
Dim i As Integer

Set wks1 = Sheets("Forms")
Set wks2 = Sheets("Ins")

lastLine = wks1.UsedRange.Rows.Count

For i = 2 To lastLine
    frmNum = wks1.Cells(i, 4).Value
    If Len(frmNum) > 0 Then
        Set f = wks2.Columns(1).Find(frmNum, LookIn:=xlValues, lookat:=xlWhole)
        If Not f Is Nothing Then
            f.Offset(0, 1).Resize(1, 9).Copy wks1.Cells(i, 5)
        Else
            wks1.Cells(i, 5).Value = "??"
        End If
    End If
Next i


End Sub
于 2013-09-25T16:12:27.427 回答
0

这里有更多关于我在评论中的意思，如果你只是想要你所要求的，可以使用公式来完成：

公式为：

B2 = =IF(A2<>"",VLOOKUP(A2,Ins!$A$1:$C$14,2,FALSE),"")

和

C2 = =IF(A2<>"",VLOOKUP(A2,Ins!$A$1:$C$14,3,FALSE),"")

如果您的 Ins 工作表如下所示：

在此处输入图像描述

然后你的Forms工作表在公式被下拉后将如下所示：

在此处输入图像描述

于 2013-09-25T16:19:31.030 回答