Question

Scott已解决了有关语法的先前问题，将文件名放入主工作簿。稍作修改的新问题

基本上，我在一个文件夹中有数百个文件，而且我正在将所有数据从这些文件复制到主工作簿中，再到源和目标选项卡名称都匹配的选项卡上。一切运行正常，除了将文件名放在已复制的数据旁边，问题是，它仅填充第一行，因为它是空白，我认为是因为以下行：

lLastRow = wsDst.UsedRange.Rows(wsDst.UsedRange.Rows.Count).Row + 1

这是代码。我很确定这样做有一种简单的方法

Sub ProjectMacro()
Dim wbDst As Workbook
Dim wsDst As Worksheet
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Dim lLastRow As Long
Dim lLastColumn As Long
Dim LC As Long
Dim s As Worksheet, t As String
Dim i As Long, K As Long
K = Sheets.Count


Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False


Set wbDst = ThisWorkbook
MyPath = "C:\Users\tomhardy\Desktop\787 files\"
strFilename = Dir(MyPath & "*.xls*", vbNormal)

Do While strFilename <> ""
'loop through each worksheet in the source file
For Each wsSrc In wbSrc.Worksheets
    'Find the corresponding worksheet in the destination with 
the same name as the source
  On Error Resume Next
Set wsDst = wbDst.Worksheets(wsSrc.Name)
    On Error GoTo 0
If wsDst.Name = wsSrc.Name Then
lLastRow = 
 wsDst.UsedRange.Rows(wsDst.UsedRange.Rows.Count).Row + 1    
 lLastColumn =wsDst.UsedRange.Columns(wsDst.UsedRange.Columns.Count).Column + 1
  wsSrc.UsedRange.Copy
 wsDst.Range("A" & lLastRow).PasteSpecial xlPasteValues
 wsDst.Cells(1,lLastColumn).Value = wbDst.FullName
 End If
 Application.CutCopyMode = False
Next wsSrc


wbSrc.Close False
strFilename = Dir()
Loop

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
End Sub

Answer 1

尝试一下：

wsDst.Cells(1,lLastColumn).Resize(wsSrc.UsedRange.Rows.Count,1).Value = wbDst.FullName

代码本身应该足以说明其工作方式。

或者这，因为我不是100％确切地确定您想要什么。

wsDst.Range("A" & lLastRow).Resize(wsSrc.UsedRange.Rows.Count,1).Value = wbDst.FullName

在最后填充的列之后的文件夹中放置文件名时出错

1 个答案: