Excel VBA如何将WorkSheet名称与Cell值匹配,然后复制并粘贴一系列单元格

时间:2017-04-20 01:22:32

标签: vba excel-vba excel

当“目标”工作簿的顶部单元格与工作表的名称匹配时,我只是尝试将值从一个工作簿复制并粘贴到另一个工作簿。

但大部分时间它都给我1004错误。有任何想法吗?

Sub Cycle()

Dim ws As Worksheet
Dim y As Integer

 For Each ws In ThisWorkbook.Sheets
            ActiveSheet.Name = Worksheets("Target").Cells(1, y)
            Worksheets("Target").Range(Cells(2, y), Cells(24, y)).Copy
            Selection.Copy
            ActiveSheet.Range("e3").Paste
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

            y = y + 1


        Next ws

End Sub

1 个答案:

答案 0 :(得分:0)

我不确定我是否理解你想要的东西,但试一试:

Sub Cycle()

Dim ws As Worksheet
Dim wsTarg As Worksheet: Set wsTarg = Worksheets("Target")
Dim y As Integer

For Each ws In ThisWorkbook.Sheets
    y = 1
    While (wsTarg.Cells(1, y) <> vbNullString)
        If ws.Name = wsTarg.Cells(1, y) Then
            wsTarg.Range(wsTarg.Cells(3, y), wsTarg.Cells(25, y)).Value = _
                ws.Range(ws.Cells(1, 1), ws.Cells(23, 1)).Value
        End If
        y = y + 1
    Wend
Next ws
End Sub

这不是最好的方法(我们可以优化以避免验证已经复制的列并且不验证目标电子表格),但它会查找所有工作表并与第一个上的所有单元格进行比较目标表上的一行。如果工作表的名称与单元格名称完全相同,则会将第一列(单元格1到23)复制到目标工作表中的单元格3到25上。

我希望这有帮助!