繁体   English   中英

在一个工作簿中查找并复制单元格

[英]Finding and Copying Cells from One Workbook to Another

我有一个可以正常工作的代码,在这里我用工作簿1中列表中的名称在工作簿1中创建了一个新工作表的加载。然后,它从工作簿中另一个工作表中复制单元格并将工作表名称放在单元格D1中。 这按预期工作。

然后,我想在另一个工作簿中查找新的工作表名称,并复制一些与其行号有关的单元格。 我的代码打开了工作簿2(设置为wbtemps),但随后似乎没有转到工作簿2中的指定工作表并找到了该单元格。 我尝试将代码分成几部分,如果我事先选择了工作表,它将找到该单元格,但是它似乎仍然没有复制我想要的单元格...

任何帮助,将不胜感激。 我显然在某处错过了一些东西...

Set wb = ActiveWorkbook

InpFolder = ThisWorkbook.Path & "\Matrix_Inputs\"
MyValue1 = InputBox("WP1 Draft Matrix Filename", "Input", "Filename")

For Each cell In wsWithSheetNames.Range(Range("B5"), Range("B5").End(xlDown))
    With wb
      .Sheets.Add after:=.Sheets(.Sheets.Count)
      On Error Resume Next
      ActiveSheet.Name = RemoveSpecialCharactersAndTruncate(cell.Value)
      Sheets("Template").Cells.Copy ActiveSheet.Range("A1")
      ActiveSheet.Range("D1").Value = cell.Value

      Application.ScreenUpdating = False
      Set wbtemp = Workbooks.Open(InpFolder & MyValue1 & ".xls*", True, True) 'The code works up to here
      Set n = wbtemp.Sheets("2_Matrix Likely Pressures").Range("B1").EntireColumn.Find(cell.Value)
      wbtemp.Sheets("2_Matrix Likely Pressures").Range(.Range("E" & n.Row), .Range("E", n.Row).End(xlToRight)).Copy
      wb.ActiveSheet.Range("B21").PasteSpecial Transpose:=True
      wbtemp.Close False
      Set wbtemp = Nothing
      Application.ScreenUpdating = True
      If Err.Number = 1004 Then
         Debug.Print cell.Value & " already used as a sheet name"
      End If
      On Error GoTo 0
    End With
Next cell

因此,最后,它似乎可以正常工作并找到我要复制的范围的唯一方法是,如果我单独选择了工作表,然后选择了要复制的范围的第一个单元格。 我知道您不必使用Select,但是似乎没有其他方法起作用(我在互联网上进行了大量搜索)。 我已经包含了我用于悲伤的那部分的最终代码。

Set wbtemp = Workbooks.Open(InpFolder & MyValue1 & ".xls*", True, True)

Set n = wbtemp.Sheets("2_Matrix Likely Pressures").Range("B1").EntireColumn.Find(cell.Value)
With wbtemp
    .Sheets("2_Matrix Likely Pressures").Select
    .Sheets("2_Matrix Likely Pressures").Cells(n.Row, "E").Select
    .Sheets("2_Matrix Likely Pressures").Range(Selection, Selection.End(xlToRight)).Copy
End With
.ActiveSheet.Range("B21").PasteSpecial Transpose:=True
Application.CutCopyMode = False

暂无
暂无

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

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