按特定内容依次将数据填充至各工作表的某个固定单元格

wspop

各位大神，如附件，
根据工作表名称，将D列其对应的数据填入该工作表A1。
注：工作表名称是乱序
例如：工作表4在A1单元格填入D4
工作表3在A1单元格填入D3

wspop

朱荣兴 发表于 2018-10-15 16:30
字典匹配即可。

大神，就是不会字典才求助的！
以下程序可以匹配到乱序的工作表，但是按绝对的行序列进行的，我想的是按工作表名称进行匹配
Sub 将一列数据依次填充至各工作表的某个固定单元格()
    Dim sheetname As String
    Dim wsht As Worksheet
   
    For Each wsht In Worksheets
        sheetname = wsht.Name
        If sheetname <> "目录" Then
            Worksheets(sheetname).Range("A1").Value = Worksheets("目录").Cells(sheetname + 1, 4)
        End If
    Next

End Sub


另外网上找了一个程序，但是执行不了，希望大神帮忙修改一下！
Sub Click()
    Dim A, B, i, j, k
    A = Sheets(1).Range("a1").CurrentRegion
   
    For i = 2 To Sheets.Count
        '分表待导入数据
        B = Sheets(i).Range("A1")    '2维
        B = Application.Transpose(B)    '1维
        For j = 2 To UBound(A)
            If A(j, 1) = Split(Sheets(i).Name)(0) Then
                '写入
                For k = 0 To UBound(B)
                    A(j, k + 9) = B(k)
                Next k
            End If
        Next j
    Next i
   
    Sheets(1).Range("i2:ad55555").ClearContents
    Sheets(1).Range("a1").Resize(UBound(A), UBound(A, 2)) = A
End Sub