Gknopka (Автор тем)

Макрос для повторной вставки значений из списка и сохранение под названиями "& I"

Пользователь

Сообщений: 15 Регистрация: 23.03.2015

13.11.2015 14:49:23

Добрый всем день. Подскажите, где и что я делаю не так:)

У меня есть пример акта приема передачи (Акт.xls), есть список заказчиков (Список.xls), я вставляю значения из Списка в акт и сохраняю каждый под своим названием (значение из ячейки "S3" Акта), то есть 1, 2, 3 и т.д.. Но что-то не выходит у меня...

Код

Sub Сохранение()
'
' Сохранение Макрос
'
    Windows("Список.xlsx").Activate
For i = 2 To lRow
    If Range("A" & i) = "" Then Exit For
    Range("B" & i).Select
    Selection.Copy
    Windows("Акт.xls").Activate
    Range("B7:AG7").Select
    ActiveSheet.Paste
    Windows("Список.xlsx").Activate
    Range("A" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Акт.xls").Activate
    Range("S3").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Имя_для_сохранения$ = "S3"
    ActiveWorkbook.SaveAs Filename:= _
        "Z:\Общая 2015\Проекты 2015\Брянск\Отгрузка\Акт\Имя_для_сохранения.xls", FileFormat:=xlExcel8 _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
        Next
End Sub

Макрос не выдает никаких ошибок, просто не происходит ничего...

Изменено: Gknopka - 13.11.2015 14:50:18

Перейти

Перенос цен по артиклу с помощью VBA

Gknopka

Пользователь

Сообщений: 15 Регистрация: 23.03.2015

11.09.2015 12:11:46

Ситуация такая. Есть два файла, один прайс от поставщика, второй наш. Нужно наладить макрос переноса цен при поиске по артиклу.
Сначала попробовала через "Запись макроса", но там не все вышло

Код

Sub Замена_Цен()
'
' Замена_Цен Макрос
'

'
    Sheets("Лист1").Select
    Range("A2").Select
    Selection.Copy
    Windows("Дошкольное оборудование.xlsm").Activate
    Sheets("Игровые пособия").Select
    Cells.Find(What:="1001", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Windows("Прайс_Громов.xls").Activate
    Range("D2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Дошкольное оборудование.xlsm").Activate
    Range("E41").Select
    ActiveSheet.Paste
    Windows("Прайс_Громов.xls").Activate
    Range("A3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Дошкольное оборудование.xlsm").Activate
    Cells.Find(What:="1002", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Windows("Прайс_Громов.xls").Activate
    Range("D3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Дошкольное оборудование.xlsm").Activate
    Range("E42").Select
    ActiveSheet.Paste
    Windows("Прайс_Громов.xls").Activate
End Sub

1.Попыталась заменить Cells.Find(What:="1001", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate на "Paste", чтобы бралось не конкретное значение, а из буфера обмена, но это не сработало
2. Windows("Дошкольное оборудование.xlsm").Activate Range("E41").Select
ActiveSheet.Paste
Тут не понимаю, как сделать, чтобы бралось опять же не конкретное значение E41, а значение из пункта 1, но в столбце E.

Прошу подсказать, если кто сможет. Файлы Прайс и Дошкольное оборудование в приложении.

Перейти

Остановка макроса если ячейка пуста

Gknopka

Пользователь

Сообщений: 15 Регистрация: 23.03.2015

23.03.2015 10:58:11

Добрый день! Подскажите, пожалуйста. Я новичок в VBA, пришлось писать макрос, чтобы облегчить работу. Но у меня не выходит что-то :)

Sub Макрос1()
'
' Макрос1 Макрос
'
Range("C5";).Select
Selection.Copy
Sheets("Лист2";).Select
Range("B10:H10";).Select
ActiveSheet.Paste
Sheets("Лист2";).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=CInt(Sheets("Лист1";).Range("D5";))
If Range("D5";) = "" Then как сделать, чтобы если ячейка не пустая, то макрос продолжал работать? а то у меня останавливается
End
End If

Range("C6";).Select
Selection.Copy
Sheets("Лист2";).Select
Range("B10:H10";).Select
ActiveSheet.Paste
Sheets("Лист2";).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=CInt(Sheets("Лист1";).Range("D6";))
If Range("D6";) = "" Then
End
End If

Range("C7";).Select
Selection.Copy
Sheets("Лист2";).Select
Range("B10:H10";).Select
ActiveSheet.Paste
Sheets("Лист2";).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=CInt(Sheets("Лист1";).Range("D7";))
If Range("D7";) = "" Then
End
End If

Также вопрос, есть ли возможность как-то упростить этот макрос? У меня тут кусок на три "строчки", а их 200! И все повторяется меняются только значения по столбцам C и D

Перейти