VBA Apvienojiet vairākus Excel failus vienā darbgrāmatā

Šī apmācība parādīs, kā apvienot vairākus Excel failus vienā darbgrāmatā VBA

Lai izveidotu vienu darbgrāmatu no vairākām darbgrāmatām, izmantojot VBA, ir jāveic vairākas darbības.

• Jums jāizvēlas darbgrāmatas, no kurām vēlaties iegūt avota datus - avota failus.
• Jums jāizvēlas vai jāizveido darbgrāmata, kurā vēlaties ievietot datus - galamērķa fails.
• Jums ir jāizvēlas lapas no nepieciešamajiem avota failiem.
• Jums ir jāpasaka kods, kur ievietot datus galamērķa failā.

Apvienojot visas lapas no visām atvērtajām darbgrāmatām uz jaunu darbgrāmatu kā atsevišķas lapas

Tālāk redzamajā kodā ir jāatver faili, no kuriem jums ir jākopē informācija, jo Excel pārmeklēs atvērtos failus un kopēs informāciju jaunā darbgrāmatā. Kods tiek ievietots personīgajā makro darbgrāmatā.

Šie faili ir TIKAI Excel faili, kuriem vajadzētu būt atvērtiem.

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647

Sub CombineMultipleFiles ()Par kļūdu GoTo eh'deklarēt mainīgos, lai turētu nepieciešamos objektusDim wbDestination As WorkbookDim wbSource As WorkbookDim wsSource kā darblapaDim wb kā darbgrāmataDim sh kā darblapaDim strSheetName kā virkneDim strDestName kā virkneizslēdziet ekrāna atjaunināšanu, lai paātrinātu lietasApplication.ScreenUpdating = Nepareizivispirms izveidojiet jaunu mērķa darbgrāmatuIestatiet wbDestination = Workbooks.Add'iegūstiet jaunās darbgrāmatas nosaukumu, lai jūs to izslēgtu no tālāk norādītās cilpasstrDestName = wbDestination.NameTagad apskatiet visas atvērtās darbgrāmatas, lai iegūtu datus, bet izslēdziet savu jauno grāmatu vai personīgo makro darbgrāmatuKatram wb lietojumprogrammā. Darba grāmatasJa wb.Name strDestName Un wb.Name "PERSONAL.XLSB", tadIestatiet wbSource = wbPar katru sh In wbSource.Worksheetssh. Kopēt pēc: = darbgrāmatas (strDestName). Lapas (1)Nākamais šBeigas JaNākamais wbtagad aizveriet visus atvērtos failus, izņemot jauno failu un personīgo makro darbgrāmatu.Katram wb lietojumprogrammā. Darba grāmatasJa wb.Name strDestName Un wb.Name "PERSONAL.XLSB", tadwb. Aizvērt nepatiesuBeigas JaNākamais wb"noņemiet pirmo lapu no mērķa darbgrāmatasApplication.DisplayAlerts = NepareiziIzklājlapas ("Sheet1"). DzēstApplication.DisplayAlerts = Patiess'notīriet objektus, lai atbrīvotu atmiņuIestatīt wbDestination = NekasIestatīt wbSource = NekasIestatīt wsSource = NekasIestatīt wb = nekas', kad esat pabeidzis, ieslēdziet ekrāna atjaunināšanuApplication.ScreenUpdating = NepareiziIziet no apakšnodaļaseh:MsgBox kļūda. AprakstsBeigu apakš

Noklikšķiniet uz dialoglodziņa Makro, lai palaistu procedūru no sava Excel ekrāna.

Tagad tiks parādīts jūsu apvienotais fails.

Šis kods ir izsekojis katru failu un kopējis lapu jaunā failā. Ja kādam no jūsu failiem ir vairāk nekā viena lapa - tā kopēs arī tās, ieskaitot lapas, kurās nav nekā!

Apvienojot visas lapas no visām atvērtajām darbgrāmatām vienā darblapā jaunā darbgrāmatā

Tālāk aprakstītā procedūra apvieno informāciju no visām atvērto darbgrāmatu lapām vienā darblapā jaunā izveidotā darbgrāmatā.

Informācija no katras lapas tiek ielīmēta mērķa lapā darblapas pēdējā aizņemtajā rindā.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869

Sub CombineMultipleSheets ()Par kļūdu GoTo eh'deklarēt mainīgos, lai turētu nepieciešamos objektusDim wbDestination As WorkbookDim wbSource As WorkbookDim wsDestination kā darblapaDim wb kā darbgrāmataDim sh kā darblapaDim strSheetName kā virkneDim strDestName kā virkneDim iRws kā vesels skaitlisDim iCols kā vesels skaitlisDim totRws kā vesels skaitlisDim strEndRng kā virkneDim rngSource kā diapazonsizslēdziet ekrāna atjaunināšanu, lai paātrinātu lietasApplication.ScreenUpdating = Nepareizivispirms izveidojiet jaunu mērķa darbgrāmatuIestatiet wbDestination = Workbooks.Add'iegūstiet jaunās darbgrāmatas nosaukumu, lai jūs to izslēgtu no tālāk norādītās cilpasstrDestName = wbDestination.NameTagad apskatiet visas atvērtās darbgrāmatas, lai iegūtu datusKatram wb lietojumprogrammā. Darba grāmatasJa wb.Name strDestName Un wb.Name "PERSONAL.XLSB", tadIestatiet wbSource = wbPar katru sh In wbSource.Worksheets'iegūstiet lapas rindu un kolonnu skaitush. AktivizētActiveSheet.Cells.SpecialCells (xlCellTypeLastCell). AktivizētiRws = ActiveCell.RowiCols = ActiveCell.Columniestatiet lapas pēdējās šūnas diapazonustrEndRng = sh. Šūnas (iRws, iCols). Adreseiestatiet kopējamo avotu diapazonuIestatīt rngSource = sh.Range ("A1:" & strEndRng)"atrodiet galamērķa lapas pēdējo rinduwbDestination.ActivateIestatiet wsDestination = ActiveSheetwsDestination.Cells.SpecialCells (xlCellTypeLastCell). AtlasiettotRws = ActiveCell.Row'pārbaudiet, vai ir pietiekami daudz rindu, lai ielīmētu datusJa totRws + rngSource.Rows.Count> wsDestination.Rows.Count TadMsgBox "Nav pietiekami daudz rindu, lai ievietotu datus konsolidācijas darblapā."Iet uz ehBeigas Ja'pievienojiet rindu, ko ielīmēt nākamajā rindā uz lejuJa totRws 1 Tad totRws = totRws + 1rngSource.Copy Mērķis: = wsDestination.Range ("A" un totRws)Nākamais šBeigas JaNākamais wbTagad aizveriet visus atvērtos failus, izņemot vēlamoKatram wb lietojumprogrammā. Darba grāmatasJa wb.Name strDestName Un wb.Name "PERSONAL.XLSB", tadwb. Aizvērt nepatiesuBeigas JaNākamais wb'notīriet objektus, lai atbrīvotu atmiņuIestatīt wbDestination = NekasIestatīt wbSource = NekasIestatīt wsDestination = NekasSet rngSource = NekasIestatīt wb = nekas', kad esat pabeidzis, ieslēdziet ekrāna atjaunināšanuApplication.ScreenUpdating = NepareiziIziet no apakšnodaļaseh:MsgBox kļūda. AprakstsBeigu apakš

Apvienojot visas lapas no visām atvērtajām darbgrāmatām vienā darblapā aktīvā darbgrāmatā

Ja vēlaties ieviest informāciju no visām citām atvērtajām darbgrāmatām tajā, kurā pašlaik strādājat, varat izmantot šo kodu zemāk.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081

Sub CombineMultipleSheetsToExisting ()Par kļūdu GoTo eh'deklarēt mainīgos, lai turētu nepieciešamos objektusDim wbDestination As WorkbookDim wbSource As WorkbookDim wsDestination kā darblapaDim wb kā darbgrāmataDim sh kā darblapaDim strSheetName kā virkneDim strDestName kā virkneDim iRws kā vesels skaitlisDim iCols kā vesels skaitlisDim totRws kā vesels skaitlisDim rngEnd Kā virkneDim rngSource kā diapazons'iestatiet mērķa grāmatai aktīvo darbgrāmatas objektuIestatiet wbDestination = ActiveWorkbook'iegūstiet aktīvā faila nosaukumustrDestName = wbDestination.Nameizslēdziet ekrāna atjaunināšanu, lai paātrinātu lietasApplication.ScreenUpdating = Nepareizivispirms izveidojiet jaunu mērķa darblapu savā aktīvajā darbgrāmatāApplication.DisplayAlerts = Nepareizi'atsākt nākamo kļūdu gadījumā, ja lapas navPar kļūdu Atsākt nākamoActiveWorkbook.Sheets ("Konsolidācija"). Dzēst'atiestatiet kļūdu slazdu, lai beigās pārietu uz kļūdu slazduPar kļūdu GoTo ehApplication.DisplayAlerts = Patiess'pievienojiet darblapai jaunu lapuAr ActiveWorkbookIestatīt wsDestination = .Sheets.Add (Pēc: =. Sheets (.Sheets.Count))wsDestination.Name = "Konsolidācija"Beigt arTagad apskatiet visas atvērtās darbgrāmatas, lai iegūtu datusKatram wb lietojumprogrammā. Darba grāmatasJa wb.Name strDestName Un wb.Name "PERSONAL.XLSB", tadIestatiet wbSource = wbPar katru sh In wbSource.Worksheets'iegūstiet lapas rindu skaitush. AktivizētActiveSheet.Cells.SpecialCells (xlCellTypeLastCell). AktivizētiRws = ActiveCell.RowiCols = ActiveCell.ColumnrngEnd = sh. Šūnas (iRws, iCols). AdreseIestatīt rngSource = sh.Range ("A1:" & rngEnd)"atrodiet galamērķa lapas pēdējo rinduwbDestination.ActivateIestatiet wsDestination = ActiveSheetwsDestination.Cells.SpecialCells (xlCellTypeLastCell). AtlasiettotRws = ActiveCell.Row'pārbaudiet, vai ir pietiekami daudz rindu, lai ielīmētu datusJa totRws + rngSource.Rows.Count> wsDestination.Rows.Count TadMsgBox "Nav pietiekami daudz rindu, lai ievietotu datus konsolidācijas darblapā."Iet uz ehBeigas Ja'pievienojiet rindu, ko ielīmēt nākamajā rindā uz leju, ja neesat 1. rindāJa totRws 1 Tad totRws = totRws + 1rngSource.Copy Mērķis: = wsDestination.Range ("A" un totRws)Nākamais šBeigas JaNākamais wbTagad aizveriet visus atvērtos failus, izņemot vēlamoKatram wb lietojumprogrammā. Darba grāmatasJa wb.Name strDestName Un wb.Name "PERSONAL.XLSB", tadwb. Aizvērt nepatiesuBeigas JaNākamais wb'notīriet objektus, lai atbrīvotu atmiņuIestatīt wbDestination = NekasIestatīt wbSource = NekasIestatīt wsDestination = NekasSet rngSource = NekasIestatīt wb = nekas', kad esat pabeidzis, ieslēdziet ekrāna atjaunināšanuApplication.ScreenUpdating = NepareiziIziet no apakšnodaļaseh:MsgBox kļūda. AprakstsBeigu apakš