按文件名称复制到指定表格里

Peny2020

同一目录下，只要文件名称包含“214”的就把Range("A1").CurrentRegion 的内容都复制到combine Open PO.xlsm的sheets("214")里，如果名称有"SA“的复制到Sheets("216")里。
这个遍历代码要怎么写？谢谢各位的指导。

3190496160

Sub LoadData()
Application.ScreenUpdating = False
Dim rn As Range
Dim sh As Worksheet, sht As Worksheet
Set sh = ThisWorkbook.Worksheets("214")
Set sht = ThisWorkbook.Worksheets("216")
sh.[a1].CurrentRegion.Offset(1).Clear
sht.[a1].CurrentRegion.Offset(1).Clear
f = Dir(ThisWorkbook.Path & "\*.xls*")
Do While f <> ""
    If f <> ThisWorkbook.Name Then
        Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f, 0)
        With wb.Worksheets(1)
            Set rn = .[a1].CurrentRegion.Offset(1)
        End With
        If InStr(wb.Name, "214") > 0 Then
            ws = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
            rn.Copy sh.Cells(ws, 1)
        ElseIf InStr(wb.Name, "SA") > 0 Then
            ws = sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
            rn.Copy sht.Cells(ws, 1)
        End If
        wb.Close False
    End If
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

3190496160

Old format combine.rar (50.26 KB, 下载次数: 15)

2023-4-21 15:53 上传

点击文件名下载附件

Peny2020

3190496160 发表于 2023-4-21 15:53

太感谢了，完美。谢谢了。

ykcbf1100

参与一下。

用户名用什么好

ykcbf1100 发表于 2023-4-21 16:14
参与一下。

请教下老师，如超过2个文件，代码要怎么改？谢谢

ykcbf1100

用户名用什么好 发表于 2023-4-26 19:59
请教下老师，如超过2个文件，代码要怎么改？谢谢

文件名写入a和b数组中就行了。多几个没事。

用户名用什么好

ykcbf1100 发表于 2023-4-26 20:01
文件名写入a和b数组中就行了。多几个没事。

    a = [{"214","SA"}]
    b = [{"214","216"}]
    c = [{"888","999"}]
    d = [{"AAA","BBB"}]
    For i = 1 To 2
        d(a(i)) = b(i)
   
不好意思，再麻烦您一下，还真不知怎么写进去，比如红色的是第3/4个文件名,要怎么写进数组

ykcbf1100

a = [{"214","SA","888","999"}]
b = [{"214","216","AAA","BBB"}]