Question

我该怎么做才能做到这一点？

工作簿名为＆＃34; 1＆＃34;：
对于范围B2：R90，
如果B2不是空白，则复制C2，E2，G2，L2＆amp; M2，
自动打开名为＆＃34; 2＆＃34;，
的工作簿并粘贴到B2，
如果B3不是空白，则复制C3，E3，G3，L3＆amp; M3，粘贴到工作簿的B3＆＃34; 2＆＃34;，继续。
完成后，关闭并保存工作簿＆＃34; 2＆＃34;，但保留工作簿＆＃34; 1＆＃34;，打开。

我只知道使用以下方法编写代码，但我确信这不起作用...＆gt;＆lt;

For Each cell In Sheets("01OCT")
    If Not IsEmpty(Range("B5:R90").Value) Then
       Copy
       Else
       Nothing
    End If
Next

Answer 1

假设您想要增加粘贴值的单元格（B2，B3 ...）而不是每次都覆盖B2，并且假设您不需要除单元格内容之外的任何内容，则以下内容应该有效为你：

Sub copyCells()
    Dim mainWb As Workbook, mainWs As Worksheet
    Dim someWb As Workbook

    Set mainWb = ThisWorkbook
    Set mainWs = mainWb.Worksheets("01OCT")

    Application.ScreenUpdating = False

    Workbooks.Open fileName:="C:\path\2.xlsx", ReadOnly:=False
    Set someWb = Workbooks("2.xlsx")
    mainWs.Activate

    For i = 2 To mainWs.Range("B5:R90").Rows.count
        If Not IsEmpty(Range("B" & i).Value) Then
            someWb.Worksheets(1).Range("B" & i).Value = mainWs.Range("C" & i).Value
            someWb.Worksheets(1).Range("C" & i).Value = mainWs.Range("E" & i).Value
            someWb.Worksheets(1).Range("D" & i).Value = mainWs.Range("G" & i).Value
            someWb.Worksheets(1).Range("E" & i).Value = mainWs.Range("L" & i).Value
            someWb.Worksheets(1).Range("F" & i).Value = mainWs.Range("M" & i).Value
        End If
    Next i

    Workbooks("2.xlsx").Close SaveChanges:=True

    Application.ScreenUpdating = True
End Sub

Answer 2

更改文件夹名称＆amp;工作簿名称＆amp;工作表名称到套件

Sub GetDataTo2()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim r As Long

    Dim bk As Workbook
    Dim sh As Worksheet
    Dim rws As Long

    Set wb = Workbooks("1.xlsm")
    Set ws = wb.Sheets("Sheet1")
    Application.ScreenUpdating = 0

    With ws
        r = .Cells(.Rows.Count, "B").End(xlUp).Row
        .Columns("B:B").AutoFilter Field:=1, Criteria1:="<>"

        Set bk = Workbooks.Open("C:\Users\Dave\Downloads\2.xlsx")
        Set sh = bk.Sheets("Sheet1")

        With sh
            rws = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            ws.Range("C2:C" & r & ",E2:E" & r & ",G2:G" & r & ",L2:M" & r).Copy
            .Range("A" & rws).PasteSpecial xlPasteValues
        End With

        bk.Save
        bk.Close True
        .AutoFilterMode = 0
    End With

End Sub

如果目标单元格不为空，如何复制同一行中的特定单元格

2 个答案: