Dim wb As Workbook Dim ws1 As Worksheet Dim ws2 As Worksheet Dim lastRow1 As Long Dim lastRow2 As Long Dim i As Long Dim file1 As Variant Dim file2 As Variant
' Выбор файла 1 file1 = Application.GetOpenFilename("Excel файлы (*.xlsm; *.xls), *.xlsm;*.xls") If file1 = False Then Exit Sub ' Проверка на отмену выбора файла
' Выбор файла 2 file2 = Application.GetOpenFilename("Excel файлы (*.xlsx; *.xls), *.xlsx;*.xls") If file2 = False Then Exit Sub ' Проверка на отмену выбора файла
Set wb = Workbooks.Open(file1) Set ws1 = wb.Worksheets("Sheet1")
Set wb2 = Workbooks.Open(file2) Set ws2 = wb2.Worksheets("Юр. лица")
Set ws1 = Nothing Set ws2 = Nothing Set wb = Nothing Set wb2 = Nothing
End Sub
[/vba]
Должен если в файле 1 в колонке BC стоит слово Нет, то он должен перенести в файл 2 значения с колонки АА в колонку С, с колонки AB в колонку D, с колонки BN в колонку E
Собственно сам код:
[vba]
Код
Dim wb As Workbook Dim ws1 As Worksheet Dim ws2 As Worksheet Dim lastRow1 As Long Dim lastRow2 As Long Dim i As Long Dim file1 As Variant Dim file2 As Variant
' Выбор файла 1 file1 = Application.GetOpenFilename("Excel файлы (*.xlsm; *.xls), *.xlsm;*.xls") If file1 = False Then Exit Sub ' Проверка на отмену выбора файла
' Выбор файла 2 file2 = Application.GetOpenFilename("Excel файлы (*.xlsx; *.xls), *.xlsx;*.xls") If file2 = False Then Exit Sub ' Проверка на отмену выбора файла
Set wb = Workbooks.Open(file1) Set ws1 = wb.Worksheets("Sheet1")
Set wb2 = Workbooks.Open(file2) Set ws2 = wb2.Worksheets("Юр. лица")
Set ws1 = Nothing Set ws2 = Nothing Set wb = Nothing Set wb2 = Nothing
End Sub
[/vba]
Должен если в файле 1 в колонке BC стоит слово Нет, то он должен перенести в файл 2 значения с колонки АА в колонку С, с колонки AB в колонку D, с колонки BN в колонку EOh_Nick
Oh_Nick, Здравствуйте. А file1 если его открыть самому (в ручную) нет никакой ошибки при открытие? Возможно сам файл повреждён. И ещё раз проверьте правильность название Листа, возможно всё же есть ошибка в название.
Oh_Nick, Здравствуйте. А file1 если его открыть самому (в ручную) нет никакой ошибки при открытие? Возможно сам файл повреждён. И ещё раз проверьте правильность название Листа, возможно всё же есть ошибка в название.MikeVol
Oh_Nick, а Вас не смущает, что Вы кодом из первого файла (который с макросом) пытаетесь открыть/открываете этот же самый файл повторно? Меня так очень смущает...
Oh_Nick, а Вас не смущает, что Вы кодом из первого файла (который с макросом) пытаетесь открыть/открываете этот же самый файл повторно? Меня так очень смущает...Gustav
Oh_Nick, И ещё, у вас таблица не начинается со второй строки как у вас в цикле: For i = 2 To lastRow1 Вроде вы давно тут на форуме, должны быть уже более на опыте, скажем так. Ну а код должен быть вот таким по итогу: [vba]
Код
Option Explicit
Sub add() Dim i As Long
' ' Выбор файла 1 ' Dim file1 As Variant: file1 = Application.GetOpenFilename("Excel файлы (*.xlsm; *.xls), *.xlsm;*.xls") ' If file1 = False Then Exit Sub ' Проверка на отмену выбора файла
' Выбор файла 2 Dim file2 As Variant: file2 = Application.GetOpenFilename("Excel файлы (*.xlsx; *.xls), *.xlsx;*.xls") If file2 = False Then Exit Sub ' Проверка на отмену выбора файла
Dim wb As Workbook: Set wb = ActiveWorkbook ' Workbooks.Open(file1) Dim ws1 As Worksheet: Set ws1 = wb.Worksheets("Sheet1")
Dim wb2 As Workbook: Set wb2 = Workbooks.Open(file2) Dim ws2 As Worksheet: Set ws2 = wb2.Worksheets("Юр. лица")
Dim lastRow1 As Long: lastRow1 = ws1.Cells(ws1.Rows.Count, "BC").End(xlUp).Row
For i = 8 To lastRow1
If ws1.Range("BC" & i).Value = "нет" Then
Dim lastRow2 As Long: lastRow2 = ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row
пытаетесь открыть/открываете этот же самый файл повторно
Oh_Nick, И ещё, у вас таблица не начинается со второй строки как у вас в цикле: For i = 2 To lastRow1 Вроде вы давно тут на форуме, должны быть уже более на опыте, скажем так. Ну а код должен быть вот таким по итогу: [vba]
Код
Option Explicit
Sub add() Dim i As Long
' ' Выбор файла 1 ' Dim file1 As Variant: file1 = Application.GetOpenFilename("Excel файлы (*.xlsm; *.xls), *.xlsm;*.xls") ' If file1 = False Then Exit Sub ' Проверка на отмену выбора файла
' Выбор файла 2 Dim file2 As Variant: file2 = Application.GetOpenFilename("Excel файлы (*.xlsx; *.xls), *.xlsx;*.xls") If file2 = False Then Exit Sub ' Проверка на отмену выбора файла
Dim wb As Workbook: Set wb = ActiveWorkbook ' Workbooks.Open(file1) Dim ws1 As Worksheet: Set ws1 = wb.Worksheets("Sheet1")
Dim wb2 As Workbook: Set wb2 = Workbooks.Open(file2) Dim ws2 As Worksheet: Set ws2 = wb2.Worksheets("Юр. лица")
Dim lastRow1 As Long: lastRow1 = ws1.Cells(ws1.Rows.Count, "BC").End(xlUp).Row
For i = 8 To lastRow1
If ws1.Range("BC" & i).Value = "нет" Then
Dim lastRow2 As Long: lastRow2 = ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row
так у вас ничего и не перенесёться, вы просто пытаетесь копировать из одной книги в другую. И то, не совсем понятно что вы пытаетесь сделать этим кодом. Разве что просто открыть вторую книгу и всё! В этом кусочке кода [vba]
Код
ws2.Range("C" & lastRow2 + 1).Value
[/vba] вы просто типа копируете первую пустую ячейку с листа второй книги которую вы открыли. Вы можете просто объяснить что вам вообще надо получить в конечно результате и не прикладывая чужих кодов которые вообще не подходят вам?
так у вас ничего и не перенесёться, вы просто пытаетесь копировать из одной книги в другую. И то, не совсем понятно что вы пытаетесь сделать этим кодом. Разве что просто открыть вторую книгу и всё! В этом кусочке кода [vba]
Код
ws2.Range("C" & lastRow2 + 1).Value
[/vba] вы просто типа копируете первую пустую ячейку с листа второй книги которую вы открыли. Вы можете просто объяснить что вам вообще надо получить в конечно результате и не прикладывая чужих кодов которые вообще не подходят вам? MikeVol