با سلام
کد زیر را کپی و تست کنید
کد:
Private Sub CommandButton1_Click()
'Dim C As String
'C = Application.InputBox("äÇã ÝÇíá ÑÇ æÇÑÏ ˜äíÏ", "ÏÑíÇÝÊ ÇØáÇÚÇÊ", "b")
'Workbooks.Open Filename:=ThisWorkbook.Path & "/" & C & ".XLSM"
'
'
'
'
RunThisMacro
End Sub
Sub RunThisMacro()
Dim C As String
C = Application.InputBox("äÇã ÝÇíá ÑÇ æÇÑÏ ˜äíÏ", "ÏÑíÇÝÊ ÇØáÇÚÇÊ", "b")
'We're doing the same thing, just to 2 different workbooks
Call OpenCopyPaste(Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & C & ".XLSM"))
'
End Sub
Sub OpenCopyPaste(sourceWB As Workbook)
Dim destWB As Workbook
Dim destWS As Worksheet
Dim copyRange As Range
'Define where our objects are, just to avoid confusion
Set destWB = Workbooks("a.xlsm")
Set destWS = destWB.Worksheets("Sheet1")
'Only copy the used section, not entire columns
With sourceWB.Worksheets("Sheet3")
Set copyRange = Intersect(.Range("A:G"), .UsedRange)
End With
' copy the source range to first blank line
With destWS
copyRange.Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
End With
'Close files
Application.CutCopyMode = False
sourceWB.Close False
destWB.Save
End Sub
هر چند بدون باز کردن فایل هم میتوانستید از آن کپی بگیرید و نیازی به باز کردن آن نبود.
با تشکر میر
علاقه مندی ها (Bookmarks)