在不打开目标WB的情况下,使用Excel将工作表从一个WB复制到另一个WB

d4so4syb  于 2023-11-20  发布在  其他
关注(0)|答案(2)|浏览(158)

我是新手,试图自动更新工作簿。我有一个源 * 工作簿A* 和一个目标 * 工作簿B*。两者都有一个工作表称为 * 转出摘要 *。我希望用户更新A中的此工作表,然后单击更新按钮,该按钮应运行我的宏。此宏应自动更新工作簿B中的工作表,而无需打开工作簿B。
我正在尝试这段代码,但它不工作,并给我一个错误:

  1. Dim wkb1 As Workbook
  2. Dim sht1 As Range
  3. Dim wkb2 As Workbook
  4. Dim sht2 As Range
  5. Set wkb1 = ActiveWorkbook
  6. Set wkb2 = Workbooks.Open("B.xlsx")
  7. Set sht1 = wkb1.Worksheets("Roll Out Summary") <Getting error here>
  8. Set sht2 = wkb2.Sheets("Roll Out Summary")
  9. sht1.Cells.Select
  10. Selection.Copy
  11. Windows("B.xlsx").Activate
  12. sht2.Cells.Select
  13. Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
  14. xlNone, SkipBlanks:=False, Transpose:=False

字符串

kkbh8khc

kkbh8khc1#

sht1sht2应该被声明为Worksheet。至于更新工作簿而不打开它,它可以完成,但需要不同的方法。为了让它看起来像你没有打开工作簿,你可以打开/关闭ScreenUpdating
试试这个:

  1. Dim wkb1 As Workbook
  2. Dim sht1 As Worksheet
  3. Dim wkb2 As Workbook
  4. Dim sht2 As Worksheet
  5. Application.ScreenUpdating = False
  6. Set wkb1 = ThisWorkbook
  7. Set wkb2 = Workbooks.Open("B.xlsx")
  8. Set sht1 = wkb1.Sheets("Roll Out Summary")
  9. Set sht2 = wkb2.Sheets("Roll Out Summary")
  10. sht1.Cells.Copy
  11. sht2.Range("A1").PasteSpecial xlPasteValues
  12. Application.CutCopyMode = False
  13. wkb2.Close True
  14. Application.ScreenUpdating = True

字符串

展开查看全部
wtzytmuj

wtzytmuj2#

用这个-这个对我有用

  1. Sub GetData()
  2. Dim lRow As Long
  3. Dim lCol As Long
  4. lRow = ThisWorkbook.Sheets("Master").Cells()(Rows.Count, 1).End(xlUp).Row
  5. lCol = ThisWorkbook.Sheets("Master").Cells()(1, Columns.Count).End(xlToLeft).Column
  6. If Sheets("Master").Cells(2, 1) <> "" Then
  7. ThisWorkbook.Sheets("Master").Range("A2:X" & lRow).Clear
  8. 'Range(Cells(2, 1), Cells(lRow, lCol)).Select
  9. 'Selection.Clear
  10. MsgBox "Creating Updated Master Data", vbSystemModal, "Information"
  11. End If
  12. 'MsgBox ("No data Found")
  13. 'End Sub
  14. cell_value = Sheets("Monthly Summary").Cells(1, 4)
  15. If cell_value = "" Then
  16. Filename = InputBox("No Such File Found,Enter File Path Manually", "Bad Request")
  17. Else
  18. MsgBox (cell_value)
  19. Path = "D:\" & cell_value & "\"
  20. Filename = Dir(Path & "*.xlsx")
  21. If Filename = "" Then
  22. Filename = InputBox("No Such File Found,Enter File Path Manually", "Bad Request")
  23. Else
  24. Do While Filename <> ""
  25. On Error GoTo ErrHandler
  26. Application.ScreenUpdating = False
  27. Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
  28. ActiveWorkbook.Sheets("CCA Download").Activate
  29. LastRow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row
  30. Range("A2:X" & LastRow).Select
  31. Selection.Copy
  32. ThisWorkbook.Sheets("Master").Activate
  33. LastRow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Select
  34. 'Required after first paste to shift active cell down one
  35. Do While Not IsEmpty(ActiveCell)
  36. ActiveCell.Offset(1, 0).Select
  37. Loop
  38. ActiveCell.Offset(0, -3).Select
  39. Selection.PasteSpecial xlPasteValues
  40. Workbooks(Filename).Close
  41. Filename = Dir()
  42. Loop
  43. End If
  44. End If
  45. Sheets("Monthly Summary").Activate
  46. 'Sheets("Monthly Summary").RefreshAll
  47. Dim pvtTbl As PivotTable
  48. For Each pvtTbl In ActiveSheet.PivotTables
  49. pvtTbl.RefreshTable
  50. Next
  51. 'Sheets("Monthly Sumaary").Refresh
  52. MsgBox "Monthly MIS Created Sucessfully", vbOKCancel + vbDefaultButton1, "Sucessful"
  53. ErrHandler:
  54. Application.EnableEvents = True
  55. Application.ScreenUpdating = True
  56. End Sub

字符串

展开查看全部

相关问题