2016-11-18 9 views
1

Нужна помощь в кодировании в VBA Excel. Итак, в настоящее время у меня есть более 100 таблиц и приходится вручную вводить все данные в каждую таблицу из разных файлов Excel из каждого региона. Вы можете посмотреть изображение таблицы здесь: https://i.stack.imgur.com/ftLdE.pngExcel VBA Копирование из различных ячеек из разных книг

Мой текущий код все еще зависит от таргетинга на диапазон ячеек для копирования, что невозможно, учитывая, что есть изменения в строках/столбцах.

Можно ли все же получить все данные из файла Excel в каждом регионе и вставить его?

Или можно настроить таргетинг на заголовок или имя таблицы, чтобы он мог автоматически заполняться? Простите меня, если решение настолько прост и было задано раньше.

Большое вам спасибо за помощь.

Sub Extract() 
Dim x As Workbook 
Dim y As Workbook 
Dim OpenSource As String 
Dim OpenTarget As String 
OpenSource = Application.GetOpenFilename("File Type, *.xlsm") 
If OpenSource = "False" Then Exit Sub 
OpenTarget = Application.GetOpenFilename("File Type, *.xlsm") 
If OpenTarget = "False" Then Exit Sub 
'## Open both workbooks first: 

Set x = Workbooks.Open(OpenSource) 'Source File 'thisworkbook can implement here? 
Set y = Workbooks.Open(OpenTarget) 'Destination File 

'Now, transfer values from x to y: 
y.Sheets("Data").Range("C16:N16").Value = x.Sheets("Data").Range("C19:N19").Value 
y.Sheets("Data").Range("C34:N34").Value = x.Sheets("Data").Range("C37:N37").Value 
y.Sheets("Data").Range("C52:N52").Value = x.Sheets("Data").Range("C55:N55").Value 
y.Sheets("Data").Range("C70:N70").Value = x.Sheets("Data").Range("C73:N73").Value 
y.Sheets("Data").Range("C124:N124").Value = x.Sheets("Data").Range("C127:N127").Value 
y.Sheets("Data").Range("C286:N286").Value = x.Sheets("Data").Range("C289:N289").Value 

y.Sheets("Data").Range("R88:AC88").Value = x.Sheets("Data").Range("R91:AC91").Value 
y.Sheets("Data").Range("R106:AC106").Value = x.Sheets("Data").Range("R109:AC109").Value 
y.Sheets("Data").Range("R142:AC142").Value = x.Sheets("Data").Range("R145:AC145").Value 
y.Sheets("Data").Range("R160:AC160").Value = x.Sheets("Data").Range("R163:AC163").Value 
y.Sheets("Data").Range("R178:AC178").Value = x.Sheets("Data").Range("R181:AC181").Value 
y.Sheets("Data").Range("R196:AC196").Value = x.Sheets("Data").Range("R199:AC199").Value 
y.Sheets("Data").Range("R214:AC214").Value = x.Sheets("Data").Range("R217:AC217").Value 
y.Sheets("Data").Range("R232:AC232").Value = x.Sheets("Data").Range("R235:AC235").Value 
y.Sheets("Data").Range("R250:AC250").Value = x.Sheets("Data").Range("R253:AC253").Value 
y.Sheets("Data").Range("R268:AC268").Value = x.Sheets("Data").Range("R271:AC271").Value 

y.Sheets("Data").Range("AG88:AR88").Value = x.Sheets("Data").Range("AG91:AR91").Value 
y.Sheets("Data").Range("AG106:AR106").Value = x.Sheets("Data").Range("A109:AR109").Value 
y.Sheets("Data").Range("AG142:AR142").Value = x.Sheets("Data").Range("AG145:AR145").Value 
y.Sheets("Data").Range("AG160:AR160").Value = x.Sheets("Data").Range("AG163:AR163").Value 
y.Sheets("Data").Range("AG178:AR178").Value = x.Sheets("Data").Range("AG181:AR181").Value 
y.Sheets("Data").Range("AG196:AR196").Value = x.Sheets("Data").Range("AG199:AR199").Value 
y.Sheets("Data").Range("AG214:AR214").Value = x.Sheets("Data").Range("AG217:AR217").Value 
y.Sheets("Data").Range("AG232:AR232").Value = x.Sheets("Data").Range("AG235:AR235").Value 
y.Sheets("Data").Range("AG250:AR250").Value = x.Sheets("Data").Range("AG253:AR253").Value 
y.Sheets("Data").Range("AG268:AR268").Value = x.Sheets("Data").Range("AG271:AR271").Value 


MsgBox ("Done") 
End Sub 
+0

Если были определенные критерии, на которых основывались диапазоны, вы можете использовать это, чтобы установить начальную и конечную строки и столбец начала и конца. Другими словами, есть ли какая-либо другая информация в электронной таблице, которая заставляет вас беспокоиться о каждом из этих диапазонов? –

+0

Есть ли способ загрузить один из файлов, чтобы мы могли посмотреть? Для другого проекта я использовал код, который открывает каждый файл Excel в выбранной папке и выполняет ту же операцию (т. Е. Находит информацию и копирует их в главный файл) для всех из них автоматически. Это может быть применимо и к вам ?! – InternInNeed

+0

@ MattCremeens - единственный критерий, о котором я могу думать, - это название каждого региона и месяца, поэтому в основном его все тот же файл, который будет скомпилирован позже мной. Озабоченность будет заключаться в том, что позже будут добавлены дополнительные Регионы, чем диапазоны, которые необходимо будет динамически расширять. – Collin

ответ

1

Несомненно. до тех пор, как вы знаете начальную точку, вы можете динамически рассчитывать и скопировать строки, см изменения в коде ниже:

x.Sheets("Data").Range("C16:N" & Cells(Rows.Count, 14).End(xlUp).Row).Copy Destination:=y.Sheets("Data").Range("C19") 

, где я поставил Cells(Rows.Count,14), 14 относится к колонке N.

Применить тот же логика для остальных, и вы должны быть в порядке! дайте мне знать, как это работает, так как я его не тестировал :)

+0

Это не так, t, поскольку я получаю пустое поле вместо этого файла назначения. Позвольте мне получить код правильно, поэтому сначала начинайте с диапазона C16 и столбца N и заканчивая последней заполненной ячейкой из той же строки 16. и вызывается команда копирования. Пункт назначения тем временем начинается с диапазона C19? Нужно ли указывать, что он закончится и на N19? – Collin

+0

Извините! см. редактирование. диапазон теперь включает «C16: N». испытал и работает :) – user1

+0

Спасибо !!! Это работает, но это небольшая проблема, хотя таблица была смещена. Не знаю, почему .. Пробовал играть с изменением xlUp и диапазона, но все равно результата. Изображение: http: //imgur.com/a/2k1tG – Collin

1

Я думаю, что у нас есть цель и источник не так. Как поместить код в обратном порядке? Например. Источник должен быть из строки C19: N19 исходного файла и скопирован в строку C14: N14 целевого файла.

Sub Extract() 
Dim x As Workbook 
Dim y As Workbook 
Dim OpenSource As String 
Dim OpenTarget As String 
OpenSource = Application.GetOpenFilename("File Type, *.xlsm") 
If OpenSource = "False" Then Exit Sub 
OpenTarget = Application.GetOpenFilename("File Type, *.xlsm") 
If OpenTarget = "False" Then Exit Sub 


Set x = Workbooks.Open(OpenSource) 'Source File 
Set y = Workbooks.Open(OpenTarget) 'Destination File 

x.Sheets("Data").Range("C14:N" & Cells(Rows.Count, 14).End(xlUp).Row).Copy Destination:=y.Sheets("Data").Range("C19") 

MsgBox ("Done") 
End Sub 
+0

У меня есть работа с правильными строками, но я не могу заставить его вставлять только значения. Любая помощь здесь? x.Sheets («Данные»). Диапазон («C19»). Копирование Назначение: = y.Sheets («Данные»). Диапазон («C14: N» и ячейки (строки., 14) .End (xlUp) .Column) .PasteSpecial xlPasteValues ​​ – Collin

+0

ах да, я просто посмотрел на исходный код, а строки назначения и источника - разные. должен ли C14 быть C16? как диапазон? – user1

+0

И добавьте значение, просто скопируйте недавно вставленный диапазон и вставьте значение: – user1

Смежные вопросы