简体   繁体   中英

Range.Value not working

I'm trying to paste the rows 8-18 on sheet2 and have this looping for multiple workbooks and I want the next selection to paste on the last row. For example if the lastrow is 2 to start, it should paste between 2-12 and the following workbook should paste on 13-23 and so on. The last line that refers to ("B4") I need this to on all ten lines repeating. My code doesn't seem to be working.

        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

I believe you are trying to do this:

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

Untested, but should give the right idea. You will need to find and provide an entire range to paste into (last row destination + last row source + 1).

You could also value = value, like you have, but in my opinion it is harder to read/debug; using With statements makes it easier.

I had the code above looping through sheets in a workbook, but you can iterate through workbooks in a directory similarly.


Edit1:

In reading the comments and the updated post, I believe you're still working towards the use of lrd (last row on destination) +1, in the above code.

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

The big addition here is to put arbitrary text into the unused cells so the last row definition will be easier. You could also eliminate the lrd by using a variable to count files, also elimnating the need to use the nested loop which fills in blank cells:

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

Last note: I only showed for column 1 ("A") in my answer to demonstrate intent.


Edit2:

Declare up top:

dim k as long

Then using your existing loop, put inside like this (will need to add for the additional columns), which should only replace the section labeled '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

Add these when closing your loop:

    k = k + 1
Loop
k = 0

That should allow the k to iterate with the loop; k = 0 to start inherently, so your ranges are:

.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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM