Note: The other languages of the website are Google-translated. Back to English

Sut i ddolennu trwy ffeiliau mewn cyfeiriadur a chopïo data i mewn i brif ddalen yn Excel?

Gan dybio bod nifer o lyfrau gwaith Excel mewn ffolder, a'ch bod am ddolen trwy'r holl ffeiliau Excel hyn a chopïo data o ystod benodol o daflenni gwaith o'r un enw i mewn i brif daflen waith yn Excel, beth allwch chi ei wneud? Mae'r erthygl hon yn cyflwyno dull i'w gyflawni mewn manylion.

Dolen trwy ffeiliau mewn cyfeiriadur a chopïo data i mewn i brif ddalen gyda chod VBA


Dolen trwy ffeiliau mewn cyfeiriadur a chopïo data i mewn i brif ddalen gyda chod VBA


Os ydych chi am gopïo data penodol yn ystod A1: D4 o bob dalen1 o lyfrau gwaith mewn ffolder benodol i brif ddalen, gwnewch fel a ganlyn.

1. Yn y llyfr gwaith byddwch yn creu prif daflen waith, pwyswch y Alt + F11 allweddi i agor y Microsoft Visual Basic ar gyfer Ceisiadau ffenestr.

2. Yn y Microsoft Visual Basic ar gyfer Ceisiadau ffenestr, cliciwch Mewnosod > Modiwlau. Yna copïwch isod god VBA i mewn i'r ffenestr cod.

Cod VBA: dolennu trwy ffeiliau mewn ffolder a chopïo data i mewn i brif ddalen

Sub Merge2MultiSheets()
    Dim xRg As Range
    Dim xSelItem As Variant
    Dim xFileDlg As FileDialog
    Dim xFileName, xSheetName, xRgStr As String
    Dim xBook, xWorkBook As Workbook
    Dim xSheet As Worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    xSheetName = "Sheet1"
    xRgStr = "A1:D4"
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    With xFileDlg
        If .Show = -1 Then
            xSelItem = .SelectedItems.Item(1)
            Set xWorkBook = ThisWorkbook
            Set xSheet = xWorkBook.Sheets("New Sheet")
            If xSheet Is Nothing Then
                xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.Count)).Name = "New Sheet"
                Set xSheet = xWorkBook.Sheets("New Sheet")
            End If
            xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
            If xFileName = "" Then Exit Sub
            Do Until xFileName = ""
               Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
                Set xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
                xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
                xFileName = Dir()
                xBook.Close
            Loop
        End If
    End With
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Nodyn:

1). Yn y cod, “A1: D4"A"Sheet1”Yn golygu y bydd data yn ystod A1: D4 yr holl Daflen 1 yn cael ei gopïo i'r brif ddalen. Ac ““Taflen Newydd”Yw enw'r brif ddalen newydd ei chreu.
2). Ni ddylai'r ffeiliau Excel yn y ffolder benodol agor.

3. Gwasgwch y F5 allwedd i redeg y cod.

4. Yn yr agoriad Pori ffenestr, dewiswch y ffolder sy'n cynnwys y ffeiliau y byddwch chi'n dolennu drwyddynt, ac yna cliciwch ar y OK botwm. Gweler y screenshot:

Yna crëir prif daflen waith o'r enw “New Sheet” ar ddiwedd y llyfr gwaith cyfredol. Ac mae data yn ystod A1: D4 o'r holl Daflen 1 mewn ffolder a ddewiswyd wedi'i restru y tu mewn i'r daflen waith.


Erthyglau cysylltiedig:


Yr Offer Cynhyrchedd Swyddfa Gorau

Mae Kutools for Excel yn Datrys y rhan fwyaf o'ch Problemau, ac yn Cynyddu Eich Cynhyrchedd 80%

  • Ailddefnyddio: Mewnosod yn gyflym fformwlâu cymhleth, siartiau ac unrhyw beth rydych chi wedi'i ddefnyddio o'r blaen; Amgryptio Celloedd gyda chyfrinair; Creu Rhestr Bostio ac anfon e-byst ...
  • Bar Fformiwla Gwych (golygu llinellau lluosog o destun a fformiwla yn hawdd); Cynllun Darllen (darllen a golygu nifer fawr o gelloedd yn hawdd); Gludo i'r Ystod Hidlo...
  • Uno Celloedd / Rhesi / Colofnau heb golli Data; Cynnwys Celloedd Hollt; Cyfuno Rhesi / Colofnau Dyblyg... Atal Celloedd Dyblyg; Cymharwch y Meysydd...
  • Dewiswch Dyblyg neu Unigryw Rhesi; Dewiswch Blank Rows (mae pob cell yn wag); Darganfyddiad Gwych a Darganfyddiad Niwlog mewn Llawer o Lyfrau Gwaith; Dewis ar Hap ...
  • Copi Union Celloedd Lluosog heb newid cyfeirnod fformiwla; Auto Creu Cyfeiriadau i Daflenni Lluosog; Mewnosod Bwledi, Blychau Gwirio a mwy ...
  • Testun Detholiad, Ychwanegu Testun, Tynnu yn ôl Swydd, Tynnwch y Gofod; Creu ac Argraffu Subtotals Paging; Trosi rhwng Cynnwys a Sylwadau Celloedd...
  • Hidlo Super (arbed a chymhwyso cynlluniau hidlo i ddalenni eraill); Trefnu Uwch yn ôl mis / wythnos / dydd, amlder a mwy; Hidlo Arbennig gan feiddgar, italig ...
  • Cyfuno Llyfrau Gwaith a Thaflenni Gwaith; Uno Tablau yn seiliedig ar golofnau allweddol; Rhannwch Ddata yn Daflenni Lluosog; Trosi Swp xls, xlsx a PDF...
  • Mwy na 300 o nodweddion pwerus. Yn cefnogi Swyddfa / Excel 2007-2019 a 365. Yn cefnogi pob iaith. Defnydd hawdd yn eich menter neu sefydliad. Nodweddion llawn treial am ddim 30 diwrnod. Gwarant arian yn ôl 60 diwrnod.
tab kte 201905

Mae Tab Office yn Dod â rhyngwyneb Tabbed i'r Swyddfa, a Gwneud Eich Gwaith yn Haws o lawer

  • Galluogi golygu a darllen tabbed yn Word, Excel, PowerPoint, Cyhoeddwr, Mynediad, Visio a Phrosiect.
  • Agor a chreu dogfennau lluosog mewn tabiau newydd o'r un ffenestr, yn hytrach nag mewn ffenestri newydd.
  • Yn cynyddu eich cynhyrchiant 50%, ac yn lleihau cannoedd o gliciau llygoden i chi bob dydd!
gwaelod officetab
sylwadau (14)
Dim sgôr eto. Byddwch y cyntaf i sgorio!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
diolch am y cod vba! Mae'n gweithio'n berffaith! Hoffwn wybod beth yw'r cod os oes angen i mi LUDO FEL GWERTH yn lle hynny? Thx ymlaen llaw!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo Lai Ling,
Gall y cod canlynol eich helpu i ddatrys y broblem. Diolch i chi am eich sylw.

Is-uno2Multisheets()
Dim xRg Fel Ystod
Dim xSelItem Fel Amrywiad
Dim xFileDlg Fel FfeilDialog
Dim xFileName, xSheetName, xRgStr Fel Llinynnol
Dim xBook, xWorkBook Fel Llyfr Gwaith
Dim xTaflen Fel Taflen Waith
Ar Ail-ddechrau Gwall Nesaf
Application.DisplayAlerts = Gau
Application.EnableEvents = Gau
Application.ScreenUpdating = Anghywir
xSheetName = "Taflen1"
xRgStr = "A1:D4"
Gosod xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Gyda xFileDlg
Os .Show = -1 Yna
xSelItem = .SelectedItems.Item(1)
Gosod xWorkBook = Y Llyfr Gwaith Hwn
Gosod xSheet = xWorkBook.Sheets("Taflen Newydd")
Os yw xSheet Yn Dim Yna
xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.count)).Name = "Taflen Newydd"
Gosod xSheet = xWorkBook.Sheets("Taflen Newydd")
Gorffennwch Os
xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
If xFileName = " " Yna Gadael Is
Gwneud Tan xFileName = ""
Gosod xBook = Llyfrau Gwaith.Open(xSelItem & "\" & xFileName)
Gosod xRg = xBook.sheets(xSheetName).Range(xRgStr)
xRg.Copy xSheet.Range("A65536").Diwedd(xlUp).Gwrthbwyso(1, 0)
xFileName = Dir()
xLlyfr.Close
dolen
Gorffennwch Os
Diwedd Gyda
Gosod xRg = xSheet.UsedRange
xRg.FformatauClear
xRg.UseStandardHeight = Gwir
xRg.UseStandardWidth = Gwir
Application.DisplayAlerts = Gwir
Application.EnableEvents = Gwir
Application.ScreenUpdating = Gwir
Is-End
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, diolch am y cod. A allwch chi roi gwybod i mi sut y gallaf gynnwys enw'r ffeil Excel y copïwyd yr ystod ddata ohoni? Byddai hyn yn help mawr!

Diolch yn fawr.
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo,

Diolch am y tiwtorial.

Sut byddwn i: Dim ond yn copïo'r rhes yn "Taflen 1" gyda gwerthoedd o'r rhes "cyfanswm" a'i gludo gyda [enw ffeil] yn y brif daflen waith o'r enw “Taflen Newydd”. Gall nodi'r rhes gyda Cyfanswm fod yn wahanol ym mhob taflen waith.

Er enghraifft:
Ffeil 1: Taflen 1
Col1, Col2, Colx
1,2,15
Canlyniad, 10,50

Ffeil 2: Taflen 1
Col1, Col2, Colx
1,5,10
2,4,16
3,3,6
4,5,6
5,7,10
Canlyniad, 300,500

MasterFile: "Taflen Newydd":
ffeil1, 10, 50
ffeil2, 300, 500
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, Mae hyn yn gweithio'n wych. A oes ffordd o newid i dynnu'r gwerthoedd drosodd yn unig ac nid y fformiwla?
Diolch !!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo Trish,
Gall y cod canlynol eich helpu i ddatrys y broblem. Diolch i chi am eich sylw.

Is-uno2Multisheets()
Dim xRg Fel Ystod
Dim xSelItem Fel Amrywiad
Dim xFileDlg Fel FfeilDialog
Dim xFileName, xSheetName, xRgStr Fel Llinynnol
Dim xBook, xWorkBook Fel Llyfr Gwaith
Dim xTaflen Fel Taflen Waith
Ar Ail-ddechrau Gwall Nesaf
Application.DisplayAlerts = Gau
Application.EnableEvents = Gau
Application.ScreenUpdating = Anghywir
xSheetName = "Taflen1"
xRgStr = "A1:D4"
Gosod xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Gyda xFileDlg
Os .Show = -1 Yna
xSelItem = .SelectedItems.Item(1)
Gosod xWorkBook = Y Llyfr Gwaith Hwn
Gosod xSheet = xWorkBook.Sheets("Taflen Newydd")
Os yw xSheet Yn Dim Yna
xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.count)).Name = "Taflen Newydd"
Gosod xSheet = xWorkBook.Sheets("Taflen Newydd")
Gorffennwch Os
xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
If xFileName = " " Yna Gadael Is
Gwneud Tan xFileName = ""
Gosod xBook = Llyfrau Gwaith.Open(xSelItem & "\" & xFileName)
Gosod xRg = xBook.sheets(xSheetName).Range(xRgStr)
xRg.Copy xSheet.Range("A65536").Diwedd(xlUp).Gwrthbwyso(1, 0)
xFileName = Dir()
xLlyfr.Close
dolen
Gorffennwch Os
Diwedd Gyda
Gosod xRg = xSheet.UsedRange
xRg.FformatauClear
xRg.UseStandardHeight = Gwir
xRg.UseStandardWidth = Gwir
Application.DisplayAlerts = Gwir
Application.EnableEvents = Gwir
Application.ScreenUpdating = Gwir
Is-End
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, mae'n dal i dynnu'r fformiwlâu, nid y gwerthoedd, felly mae'n rhoi gwall #REF i mi. Rwy'n gwybod y gallai fod angen .PasteSpecial xlPasteValues ​​arno yn rhywle, ond ni allaf ddarganfod ble. Gallwch chi helpu? Diolch!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo Diolch am hyn.


Sut mae cynnwys y cod i ddolennu trwy'r holl ffolderi ac is-ffolderi a pherfformio'r copi uchod?


Diolch!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo - Mae'r cod hwn yn berffaith ar gyfer yr hyn rwy'n ceisio ei gyflawni.

A oes ffordd i ddolennu trwy'r holl ffolderi ac is-ffolderi a pherfformio'r copi?


Diolch!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo - Mae'r cod hwn yn gweithio'n dda iawn ar gyfer y 565 llinell gyntaf ar gyfer pob ffeil, ond mae'r ffeil nesaf yn gorgyffwrdd â phob llinell ar ôl hynny.
a oes ffordd i drwsio hyn?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Diolch - sut fyddai rhywun yn gallu copïo a gludo (gwerthoedd arbennig) o bob taflen waith o fewn llyfr gwaith i ddalennau ar wahân o fewn prif ffeil Meistr?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
sut ydych chi'n gwneud i god adael yn wag os yw cell yn wag?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
i mi, mae'r enw tab "Taflen1" yn newid ar gyfer pob un o'm ffeiliau. Er enghraifft, Tab1, Tab2, Tab3, Tab4... Sut alla i osod dolen i redeg trwy restr yn Excel a pharhau i newid yr enw "Taflen1" nes ei fod yn rhedeg trwy bopeth?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo Nick, Gall y cod VBA isod eich helpu i ddatrys y broblem. Rhowch gynnig arni. Ail-enwi Is-DolenTrwyFfeil()
'Diweddarwyd gan Extendoffice 2021/12/31
Dim xRg Fel Ystod
Dim xSelItem Fel Amrywiad
Dim xFileDlg Fel FfeilDialog
Dim xFileName, xSheetName, xRgStr Fel Llinynnol
Dim xBook, xWorkBook Fel Llyfr Gwaith
Dim xTaflen Fel Taflen Waith
Dim xShs Fel Taflenni
Dim xName Fel Llinyn
Dim xFNum Fel Cyfanrif
Ar Ail-ddechrau Gwall Nesaf
Application.DisplayAlerts = Gau
Application.EnableEvents = Gau
Application.ScreenUpdating = Anghywir
Gosod xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xFileDlg.Sioe
xSelItem = xFileDlg.SelectedItems.Item(1)
xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
Gwnewch Tra bod xFileName <> ""
Gosod xWorkBook = Llyfrau Gwaith.Open(xSelItem &"\" &xFileName)
Gosod xShs = xWorkBook.Sheets
Ar gyfer xFNum = 1 I xShs.Count
Gosod xSheet = xShs.Item(xFNum)
xName = xSheet.Name
xName = Amnewid(xName,"Taflen""Tab")' Amnewid y Ddalen gyda Tab
xSheet.Name = xName
Digwyddiadau
xGwaithBook.Save
xLlyfrGwaith.Close
xFileName = Dir()
dolen
Application.DisplayAlerts = Gwir
Application.EnableEvents = Gwir
Application.ScreenUpdating = Gwir
Is-End
Nid oes unrhyw sylwadau wedi'u postio yma eto
Gadewch eich sylwadau
Postio fel Gwestai
×
Graddiwch y swydd hon:
0   Cymeriadau
Lleoliadau a Awgrymir