Question

我需要宏打开wkbk（B）goto row（??）基于在wkbk中输入的值（A）复制某些colmns并粘贴回wkbk（A）中的col（j14）。

Sub AutofillData()

Dim wkbkSource As Workbook

Dim strPath As String

Dim myRange As Range

Dim i As Integer

Dim c As Range



     Application.ScreenUpdating = False

    strPath = "\\"

  Set wkbkSource = Workbooks.Open(strPath & Range("A13").Value & ".xls?")


        Windows("Book1.xlsm").Activate

         Set myRange = Range("i14:i25")

         For Each c In myRange

            i = c.Value

        wkbkSource.Activate
        Worksheets("Main Data").Select

    Range("D" & i & ":O" & i).Select
    Selection.Copy


    Windows("Book1.xlsm").Activate
    Range("J14").Select
    Sheets("Data").Cells(Rows.Count, 9).End(xlUp).Offset(1, 0).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    Range("J14").Select

Application.CutCopyMode = False

Next 

wkbkSource.Close savechanges:=False

Application.ScreenUpdating = True


End Sub

Answer 1

这样做

Sub AutofillData()

Dim wkbkSource As Workbook

Dim strPath As String
Dim myRange As Range
Dim i As Integer
Dim c As Range
Dim wkbkTarget As Workbook

Application.ScreenUpdating = False

strPath = "C:\temp\"

Set wkbkA = ThisWorkbook
Set wkbkB = Workbooks.Open(strPath & Range("A13").Value & ".xlsx")

    Set myRange = wkbkA.Sheets("Sheet2").Range("i14:i25")

    offs = 0
    For Each c In myRange

        i = c.Value

        wkbkB.Worksheets("Main Data").Range("D" & i & ":O" & i).Copy

        wkbkA.Sheets("Data").Range("J14").Offset(offs, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=True, Transpose:=False

        Application.CutCopyMode = False
        offs = offs + 1

    Next

wkbkB.Close savechanges:=False
Application.ScreenUpdating = True

End Sub

在工作表之间复制单元格

1 个答案: