遍历行,将值从某些单元格复制到另一个工作簿

Iterate through row, copy value from certain cells to another Workbook

我是 VBA 的菜鸟,一直在尝试创建一个脚本,从数据库中的以下单元格复制值(例如,从单元格 A x 复制到另一个文档中的 C11,然后 B x 到 C12,等等)然后用自定义文件名保存填充的文档。

阅读 tutorials/other stackflows 这就是我想出的:

Function WypelnianieSMT()


Dim rng As Range
Dim row As Range


Set rng = Range("A2:J29")

    For i = 2 To rng.Rows.Count

        Workbooks("LISTA CZESCI-1.xlsm").Worksheets("Arkusz1").rng.Cells(RowIndex:=i, ColumnIndex:="H").Copy
        Workbooks("Szablon Specyfikacji Materiału Technicznego.xlsx").Worksheets("Formularz klasyfikacji").Range("C11").PasteSpecial Paste:=xlPasteValues

        Workbooks("LISTA CZESCI-1.xlsm").Worksheets("Arkusz1").rng.Cells(RowIndex:=i, ColumnIndex:="I").Copy
        Workbooks("Szablon Specyfikacji Materiału Technicznego.xlsx").Worksheets("Formularz klasyfikacji").Range("C12").PasteSpecial Paste:=xlPasteValues

        Workbooks("LISTA CZESCI-1.xlsm").Worksheets("Arkusz1").rng.Cells(RowIndex:=i + 1, ColumnIndex:="G").Copy
        Workbooks("Szablon Specyfikacji Materiału Technicznego.xlsx").Worksheets("Formularz klasyfikacji").Range("C13").PasteSpecial Paste:=xlPasteValues

        Workbooks("Szablon Specyfikacji Materiału Technicznego.xlsx").SaveAs Filename:="C:\***\Desktop\Makro" & Range("C2").Value & ".xlsx", FileFormat:=xlOpenXMLStrictWorkbook, CreateBackup:=False

    Next
End Function

抱歉各位,我想脚本完全乱七八糟,但无法解决其他问题。

用错误的代码来解释你想要的东西从来都不是一个好主意。因此,尝试从头到脚都不是我的好主意。但是你做到了。我做到了。这就是我们现在的处境。希望对你有用。

Function WypelnianieSMT()
    ' 009

    ' note that 'Row' is a VBA object.
    ' The name shouldn't be used for a user-declared variable

    Dim WsList As Worksheet
    Dim WsSpecs As Worksheet
    Dim Fn As String                        ' file name
    Dim C As Long                           ' output column
    Dim R As Long                           ' input row

    ' both these workbooks must be open
    Set WsList = Workbooks("LISTA CZESCI-1.xlsm").Worksheets("Arkusz1")
    Set WsSpecs = Workbooks("Szablon Specyfikacji Materialu Technicznego.xlsx").Worksheets("Formularz klasyfikacji")

'    Dim Rng As Range
'    ' this is the joker in the deck: on which sheet is this range?
'    ' it's the ActiveSheet by default. But which is the ActiveSheet?
'    Set Rng = Range("A2:J29")

    C = 3                                   ' first column to use for output
    For R = 2 To 29
        With WsList
            .Cells(R, "H").Copy Destination:=WsSpecs.Cells(11, C)
            .Cells(R, "I").Copy Destination:=WsSpecs.Cells(12, C)
            .Cells(R, "G").Copy Destination:=WsSpecs.Cells(13, C)
        End With
        C = C + 1
    Next R

    ' you probably don't want to save the document on every loop
    ' therefore delay the sdaving until the looping is done
    ' Range("C2") is on the WsSpecs tab???
    Fn = "\Desktop\Makro" & WsSpecs.Range("C2").Value & ".xlsx"
    WsSpecs.SaveAs Filename:=Environ("Userprofile") & Fn, _
                   FileFormat:=xlOpenXMLStrictWorkbook, _
                   CreateBackup:=False
End Function

代码完全未经测试,因为我没有数据。