遍历行，将某些单元格中的值复制到另一个工作簿

Question

i'm a total noob in VBA and been trying to create a script that copies value from following cells in database (eg. copy from cell A x to C11 in another document, then B x to C12, etc.) and after that saving the filled document with a custom filename.

After reading through tutorials/other stackflows that's what I've came up with:

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

sorry guys, I suppose that the script is totally messed, but couldn't work anything else out.

Answer 1

It's never a good idea to use faulty code to explain what you want. Therefore it probably wasn't a good idea of mine to try and make head and toe of it. But you did. And I did. And this is where we are now. I hope it's useful to you.

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

The code is totally untested because I don't have data.