Question

我正在尝试将8至18行粘贴到sheet2上，并使该循环适用于多个工作簿，我希望将下一个选择粘贴到最后一行上。例如，如果lastrow是2开始，则它应粘贴在2-12之间，而以下工作簿应粘贴在13-23之间，依此类推。引用（“ B4”）的最后一行在所有十行重复中都需要使用。我的代码似乎不起作用。

        Sub PullAP()

Dim Source As Workbook
Dim MyDate, MyMonth
MyDate = Date
MyMonth = Month(MyDate) + 1
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim lastRow As Long

'Speed up macro
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
            If .Show <> -1 Then GoTo NextCode
            myPath = .SelectedItems(1) & "\"
        End With

'In Case of Cancel
NextCode:
    myPath = myPath
    If myPath = "" Then GoTo ResetSettings

'Target File Extension
    myExtension = "*.xls*"

'Target Path with Ending Extension
    myFile = Dir(myPath & myExtension)

'Loop through each excel file in folder
    Do While myFile <> ""
        'Set varibale equal to open workbook
            Set Source = Workbooks.Open(Filename:=myPath & myFile)

        'Ensure Workbook has opened before moving on to the next line of code
            DoEvents

        'Code
             lastRow = ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row + 1

            ThisWorkbook.Worksheets("Sheet2").Range("A" & lastRow).Formula = Source.Worksheets("SUMMARY DATA SHEET").Range("A8:A18").Value
            ThisWorkbook.Worksheets("Sheet2").Range("D" & lastRow).Formula = Source.Worksheets("SUMMARY DATA SHEET").Range("D8:D18").Value
            ThisWorkbook.Worksheets("Sheet2").Range("E" & lastRow).Formula = Source.Worksheets("SUMMARY DATA SHEET").Range("E8:E18").Value
            ThisWorkbook.Worksheets("Sheet2").Range("F" & lastRow).Formula = Source.Worksheets("SUMMARY DATA SHEET").Range("F8:F18").Value
            ThisWorkbook.Worksheets("Sheet2").Range("B" & lastRow).Formula = Source.Worksheets("SUMMARY DATA SHEET").Range("B4").Value

        'Close without saving
            Source.Close SaveChanges:=False

        'Ensure Workbook has closed before next line of code
            DoEvents

        'Get next file name
            myFile = Dir
    Loop

MsgBox "Task Complete!"

ResetSettings:
    'Resets optimization settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Answer 1

我相信您正在尝试这样做：

dim lrs as long, lrd as long, i as long
for i = 1 to workbooks(1).sheets.count
    with workbooks(1).sheets(i)
         lrs = .cells(.rows.count,1).end(xlup).row
         .range(.cells(1,1),.cells(lrs,1)).Copy
    end with
    with workbooks("dest").sheets("name")
         lrd = .cells(.rows.count,1).end(xlup).row
         .range(.cells(lrd+1,1),.cells(lrd+1+lrs,1)).PasteSpecial xlValues
    end with
next i

未经测试，但应该给出正确的想法。您将需要查找并提供整个范围以粘贴到（最后一行目标+最后一行源+ 1）。

您也可以像以前一样使用value = value，但是在我看来，阅读/调试比较困难；使用With语句可以更轻松。

我上面的代码在工作簿中的工作表之间循环，但是您可以类似地遍历目录中的工作簿。

编辑1：

在阅读评论和更新后的帖子时，我相信您仍在努力使用上述代码中的lrd（目标位置的最后一行）+1。

dim lrd as long, i as long, j as long
for i = 1 to workbooks(1).sheets.count
    with ThisWorkbook.Sheets("Sheet2")
         lrd = .cells(.rows.count,1).end(xlup).row
         .range(.cells(lrd+1,1),.cells(lrd+1+10,1)).Values = Source.Sheets("SUMMARY DATA SHEET").Range(Source.Sheets("SUMMARY DATA SHEET").Cells(8,"A"),Source.Sheets("SUMMARY DATA SHEET").Cells(18,"A")).Value
         do until j = (lrd+10+1)
             if .Cells(lrd+1+j,1).Value = "" then .Cells(lrd+1+j,1).Value = "N/A"
         loop
         j = 0
    end with
next i

这里最大的补充是将任意文本放入未使用的单元格中，因此最后一行的定义将更加容易。您还可以通过使用变量对文件计数来消除lrd，也消除了使用嵌套循环填充空白单元格的需要：

dim k as long
Do While myFile <> ""
    'rest of your code using destination .range(.cells(1+k*10,1),.cells(1+10+k*10,1))
    'directly before loop ends add
    k = k + 1
Loop
k=0

最后一点：我只在回答中显示第1列（“ A”）以表明意图。

编辑2：

声明顶部：

dim k as long

然后使用您现有的循环，像这样放入（需要为其他列添加），该循环仅应替换标有'Code 的部分：

with ThisWorkbook.Sheets("Sheet2")
    .range(.cells(1+k+k*10,1),.cells(1+k+k*10+10,1)).Values = Source.Sheets("SUMMARY DATA SHEET").Range(Source.Sheets("SUMMARY DATA SHEET").Cells(8,"A"),Source.Sheets("SUMMARY DATA SHEET").Cells(18,"A")).Value
end with

在关闭循环时添加以下内容：

    k = k + 1
Loop
k = 0

这应该允许k循环迭代； k = 0从本质上开始，因此您的范围是：

.range(.cells(1+0+0*10,1),.cells(1+0+0*10+10,1)).Values = A1 to A11 'first loop
.range(.cells(1+1+1*10,1),.cells(1+1+1*10+10,1)).Values = A12 to A22 'second loop
.range(.cells(1+2+2*10,1),.cells(1+2+2*10+10,1)).Values = A23 to A33 'third loop

Range.Value不起作用

1 个答案: