ba drod code zir kare shomaro rah mindaze, farz konin shoma ye folderi dari ke hameye on file haye excelet onjast, chand tasho mohem nist. ye file asli ham dari ke mikhi masalan tamame selhaye a1 file haye mazkor ro biari to in file asli zire ham bezarishon to setone A.
khob code zir mitone komaketon kone bakhshhai ro ke man baraton ghermez mikonamo bayad taghir bedi chon address folderi ke on n ta file onjast ba man fargh dare
کد:
Sub MergeSelectedWorkbooks()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim SelectedFiles() As Variant
Dim NRow As Long
Dim FileName As String
Dim NFile As Long
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Sheet1
' Modify this folder path to point to the files you want to use.
FolderPath = "Z:\k3931\Desktop\New folder\New folder"
' Set the current directory to the the folder path.
ChDrive FolderPath
ChDir FolderPath
' Open the file dialog box and filter on Excel files, allowing multiple files
' to be selected.
SelectedFiles = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 2
' Loop through the list of returned file names
For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
' Set FileName to be the current workbook file name to open.
FileName = SelectedFiles(NFile)
' Open the current workbook.
Set WorkBk = Workbooks.Open(FileName)
' Set the source range to be A1 , you can change this to any range that you want
' Modify this range for your workbooks. It can span multiple rows.
Set SourceRange = WorkBk.Worksheets(1).Range("A1")
' Set the destination range to start at column B and be the same size as the source range.
Set DestRange = SummarySheet.Range("A" & NRow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)
' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value
' Increase NRow so that we know where to copy data next.
NRow = NRow + DestRange.Rows.Count
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
Next NFile
' Call AutoFit on the destination sheet so that all data is readable.
SummarySheet.Columns.AutoFit
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
khob berim sare tozihat
khate ghermez ke hatman bayad taghir kone.bad az run shodan mostaghiman be addrese morede nazar mirin, harchandta az on filaro khastin mitonin entekhab konin
khate ghermez mishe address on foldere ke filat onjast. dar zemn alamataye "" ke hast pak nashe beinesh copy mikoni
ama khotote sabz basete be nazare shomas
masalan
کد HTML:
Set SourceRange = WorkBk.Worksheets(1).Range("A1")
to inja ma dariom migim ke on filaye ke mikhaim copy shon konim to in file aslimon. sheet1 eshon range A1 eshon ro mikhaim copy barash sorat begire tavajoh kon ke ma do ta name to code nevisi darim yeki name hast ke shoma be rahati vase sheet haton taghir midi va ye nameke code nevisi hastesh va mamolan ma az in name vase barname nevisi estefade mikonim ke agar karbar esme sheet ro taghir dad code hamon ba moshkel movajeh nashan. vaghti ye sheeti ro entekhab koni va ro tabesh rast click koni view code ro bezani ye panjare baz mishe ke samte chap mitoni befahmi esme codi on sheet chie
shoma agar khasti mitoni in 1 ro bokoni 2 ya 3 ya .. va range ro ham bezari harchi masalan C2 ya hata range mesle A2:A10
badesh mimone inke koja cop beshan to file aslimon
khate bala dare mige dadeham az radife 2 o file asli shoro be copy shodan bokonan va ama daghighan koja
کد HTML:
et DestRange = SummarySheet.Range("A" & NRow)
to setone A
hala in seton mitone taghir kone. ya hata radifi ke arz shod khedmateton. dar nahayat shoma hame etelato dari bad har balai khasi sareshon dar biar . sum begir ya har chi made nazarete
dige az in vazeh tar nemitonesam tozih bedam. inam ye hadie az taafe site bod azizam.movafagh bashi
nemone file ham mizaram ke betoni ide begiri
پاسخ با نقل قول
نوشته اصلی توسط princenothing
علاقه مندی ها (Bookmarks)