简体   繁体   English

用值填充列直到最后一行

[英]Fill column with value until last row

My code should copy data from excel file TimeSheet. 我的代码应从Excel文件TimeSheet复制数据。 Each file contains header with person name, and blocks with daily records. 每个文件都包含带有人名的标题,并带有每日记录的块。 Code is looping all excel file in folder and appending records to master file. 代码循环了文件夹中的所有excel文件,并将记录追加到主文件。 Code was partly solved here. 代码在这里已部分解决。 But now I have problem with filling out column A with Person name. 但是现在我在用人员名称填充列A时遇到了问题。

Code should first fill column B in NewSht with tasks and later grab value from filed B7 OldSht and copy it to first empty cell in column A NewSht and fill until last Row in column B. With current code I get 代码应该首先用任务填充NewSht中的B列,然后从提交的B7 OldSht中获取值,然后将其复制到NewSht列中的第一个空单元格,并填充直到B列中的最后一行。使用当前代码,我得到

'Autofill method of Range class failed' “ Range类的自动填充方法失败”

error. 错误。

Sub AllFiles()

Application.EnableCancelKey = xlDisabled

Dim folderPath As String
Dim Filename As String
Dim wb As Workbook
Dim Masterwb  As Workbook
Dim sh As Worksheet
Dim NewSht As Worksheet
Dim OldSht As Worksheet
Dim FindRng As Range
Dim target As Range
Dim LastRow As Long

' set master workbook
Set Masterwb = Workbooks("result2.xlsm")

folderPath = "C:\Users\TimeSheets2019\inside" 'contains folder path

If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
Application.ScreenUpdating = False

Filename = Dir(folderPath & "*.xlsx*")
Do While Filename <> ""
    Set wb = Workbooks.Open(folderPath & Filename, ReadOnly:=True)
    Set NewSht = Masterwb.Worksheets("Tabelle1") ' added
    Set OldSht = wb.Worksheets("Manager Form") ' added

    ' get the first empty row in the new sheet
    Set FindRng = NewSht.Cells.Find(What:="*", Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
    Set target = NewSht.Cells(NewSht.Rows.Count, 2).End(xlUp).Offset(1, 0)
LastRow = NewSht.Range("B" & Rows.Count).End(xlUp).Row
    'copy taks list to column B            
    OldSht.Range("B7:B15, B17:B26").Copy
    NewSht.Cells(NewSht.Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
' copy person name until last row in coulmn B
    OldSht.Range("B5").AutoFill Destination:=NewSht.Range("A2:A" & LastRow), Type:=xlFillDefault
    wb.Close False

Exit_Loop:
    Set wb = Nothing
    Filename = Dir
Loop
Application.ScreenUpdating = True

End Sub

TimeSheet to copy 要复制的TimeSheet

Results in Master file 主文件中的结果

As already pointed out in the comments, Range.AutoFill only works if the destination range includes the source range. 如注释中已经指出的那样, Range.AutoFill仅在目标范围包括源范围时才起作用。 You can't autofill from one sheet to another. 您无法从一张纸自动填充到另一张纸。

I think you just need a simple value transfer here: 我认为您只需要在这里进行简单的价值转移:

NewSht.Range("A2:A" & LastRow).Value = OldSht.Range("B5").Value

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

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