Я собираюсь быть щедрым и предположить, что вы не знаете, с чего начать.
Всю информацию в этом ответе можно найти, просмотрев вопросы и ответы за последние два или три месяца.На этом сайте много актуальной информации, особенно под тегом excel-vba.Вы получите лучшие ответы, если будете задавать небольшие конкретные вопросы, которые доказывают, что вы пытались.
То, что вы предлагаете, не является хорошей практикой.Вы дублируете данные в нескольких книгах, и я гарантирую книги скоро будут безнадежно не в порядке.
Поиграйтесь с приведенным ниже кодом, но затем подумайте о связывании книг, чтобы данные присутствовали толькоодин раз.Я также подозреваю, что Access был бы лучшим инструментом, если вы хотите очень разные представления одних и тех же данных.
Option Explicit
Sub WriteToOtherWorkbook()
Dim PathCrnt As String
Dim RowNext As Long
Dim WBookOther As Workbook
Dim WBookOtherName As String
' I assume all workbooks are in the same folder at the active workbook
PathCrnt = Application.ActiveWorkbook.Path
If Workbooks.Count > 1 Then
' It is easy to get into a muddle if there are multiple workbooks
' open at the start of a macro like this. Avoid the problem until
' you understand it.
Call MsgBox("Please close all other workbooks", vbOKOnly)
Exit Sub
End If
' I assume you know how to find the name of the relevant workbook.
WBookOtherName = "ABC Industries.xls"
' Open the named workbook
Set WBookOther = Workbooks.Open(PathCrnt & "\" & WBookOtherName)
With WBookOther
' I assume you have some system for naming the sheets in the
' company workbooks.
With .Sheets("XXXXXX")
' If you know that the last row will have a value in, for example,
' column "B" use this code which is the equivalent of going to
' the bottom of column "B", clicking Ctrl+Up to find the last
' cell with a value and then adding one to that value.
RowNext = .Cells(Rows.Count, "B").End(xlUp).Row + 1
' If you are not sure which column of the last row is
' guaranteed to contain a value, use this code.
RowNext = .Cells.SpecialCells(xlCellTypeLastCell).Row + 1
' Write some values to the row
.Cells(RowNext, 1) = "A"
.Cells(RowNext, 2) = "B"
End With
.Save ' Save the changes
.Close ' Close the workbook
Set WBookOther = Nothing ' Clear reference to workbook
End With
End Sub
Этот код работает с таблицами, которые ищут определенное имя.
For InxWS = 1 To Worksheets.Count
If Worksheets(InxWS).Name = "ABC Industries" Then
Found = True
Exit For
EndIf
Next
If Found Then
With Worksheets(InxWS)
' Add data
End With
Else
Call MsgBox("No worksheet for AC Industries",vbYesOK)
Endif
Надеюсь, этого достаточно, чтобы вы начали.Как я уже говорил в начале, вам нужно быть более конкретным, прежде чем кто-либо сможет предложить больше, чем просто помощь.