Finding and Copying Cells from One Workbook to Another

时间:2018-02-01 18:07:11

标签: excel vba

I have a code, which mostly works, where I create a load of new sheets in workbook 1 with names from a list in workbook 1. It then copies cells from another sheet in the workbook and put the sheet names in cell D1. This works as expected.

I then want to look in another workbook for the new sheet name and copy some cells relating to its row number. My code opens workbook 2 (set as wbtemps) but then it doesn't seem to go to the specified sheet in workbook 2 and find the cell. I have tried splitting the code into sections and if I select the sheet beforehand it finds the cell, but then it still doesn't seem to copy the cells I want...

Any help would be appreciated. I've clearly missed something somewhere...

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

1 个答案:

答案 0 :(得分:0)

所以最后,它似乎工作并找到我想要复制的范围的唯一方法是,如果我单独选择工作表,然后是我想要复制的范围的第一个单元格。我知道你不应该使用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