在工作表之间复制单元格

Question

我需要宏来打开 wkbk(B) goto row (??) based value entered in wkbk(A) copy certain colmns and paste back to col (j14) in wkbk (A).

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

在工作表之间复制单元格

Copy cells between worksheets

excel

vba