Ученик VBA (Все сообщения пользователя)

При копировани макрос VBA вставляет не тот формат (нужны только значения), Нужно загрузить данные (только значения) из 2-й кониги (на выбор пользователя) в робочую

Ученик VBA

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

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

11.01.2017 16:00:38

Добрый день!
Нужно было чтобы у книге "1001+1002 +" прописать макрос, который будет копирувать значения из книги "загрузить" Листа1 (весь диапазон) у рабочую книгу ("1001+1002 +" ) на лист "accounts" значения чисел и слов. Макрос должен загружать данные, которые потом будут отображаться на листе "Ліміти кас".
Часть списала с интернета, часть сама, и получилось:

Код

 Sub Макрос1()
    Sheets("accounts").Visible = True
    Sheets("accounts").Select
    Cells.Select ClearContents
   
    Dim FilesToOpen
    Dim x As Integer
     
    Application.ScreenUpdating = False  'отключаем обновление экрана для скорости
     
    'вызываем диалог выбора файлов для импорта
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="All files (*.*), *.*", _
      MultiSelect:=True, Title:="Files to Merge")
 
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "Не выбрано ни одного файла!"
        Exit Sub
    End If
     
    'проходим по всем выбранным файлам
    x = 1
    While x <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
        With ActiveWindow
        Sheets("Лист1").Select
        Columns("A:XFD").Copy
        End With
        ActiveWindow.Close
        ThisWorkbook.Activate
        Sheets("accounts").Select
        Range("A1").Select
        ActiveSheet.PasteSpecial Format:=False, Link:=False, _
        DisplayAsIcon:=False, NoHTMLFormatting:=False
        Sheets("accounts").Visible = False
        x = x + 1
    Wend
    Application.ScreenUpdating = True
End Sub

НО КОГДА МАКРОС ЗАГРУЖАЕТ ДАННЫЕ, то они не отображаются на листе "Ліміти кас" (догадуюсь что формат не тот загружает). Если копирую данные вручну - то все работает. Пробувала
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Выбивает ошибку. Помогите, если сможете. Спасибо

Перейти

Сохранить конкретные листы как новые файлы, Нужно несколько листов одной книги сохранить как новые книги

Ученик VBA

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

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

29.09.2016 13:01:00

Спасибо, ДОРОГОЙ И УВАЖАЕМЫЙ МатросНаЗебре - вы нашли ошибку.
Sanja, Саничка, так работает.
Какие вы умные и отзывчивые люди !!!!

Код

Sub SaveActiveSheetWithValuesAndFormats()
    arrSh = Array("Consol", "KIE", "CHR", "LVV")
For i = 0 To 3
    With Worksheets(arrSh(i))
    Dim sh As Worksheet, wbNew As Workbook, cFileName
    Set sh = Worksheets(arrSh(i))
    cFileName = Application.GetSaveAsFilename(sh.Name, "Eieaa Microsoft Office Excel (*.xls), *.xls")
    If cFileName = False Then Exit Sub
    Application.ScreenUpdating = False
    sh.Copy
    Set wbNew = ActiveWorkbook
    With wbNew.Sheets(1).UsedRange.Cells
        .Value = .Value
    End With
    Application.DisplayAlerts = False
    wbNew.SaveAs Filename:=(cFileName), FileFormat:=xlNormal
    wbNew.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    End With
    Next
    MsgBox "Ãîòîâî!"
End Sub

Перейти

Сохранить конкретные листы как новые файлы, Нужно несколько листов одной книги сохранить как новые книги

Ученик VBA

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

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

29.09.2016 12:39:57

Спасибо, Sanja
Я дописала но наверно не туда, потому что 3 раза делает лист ""Consol"

Код

Sub SaveActiveSheetWithValuesAndFormats()
    arrSh = Array("Consol", "KIE", "CHR", "LVV")
For i = 0 To 3
    With Worksheets(arrSh(i))
    Sheets("Consol").Select
    Dim sh As Worksheet, wbNew As Workbook, cFileName
    Set sh = ActiveSheet
    cFileName = Application.GetSaveAsFilename(sh.Name, "Eieaa Microsoft Office Excel (*.xls), *.xls")
    If cFileName = False Then Exit Sub
    Application.ScreenUpdating = False
    sh.Copy
    Set wbNew = ActiveWorkbook
    With wbNew.Sheets(1).UsedRange.Cells
        .Value = .Value
    End With
    Application.DisplayAlerts = False
    wbNew.SaveAs Filename:=(cFileName), FileFormat:=xlNormal
    wbNew.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    End With
    Next
    MsgBox "Ãîòîâî!"
End Sub

Перейти

Сохранить конкретные листы как новые файлы, Нужно несколько листов одной книги сохранить как новые книги

Ученик VBA

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

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

29.09.2016 12:11:49

Добрый день! Помогите подправить макрос. Есть книга из 7 листами "BS-2016", "План", "Факт", "Сonsol", "KIE", "CHR", "LVV".
Нужно только последние 4 листа сохранить как значения отдельными книгами "Сonsol", "KIE", "CHR", "LVV".
Мій горе-макрос 4 рази копирует лист "Сonsol". Подскажите пожалуйста где нужно прописать Sheets(Array("Сonsol", "KIE", "CHR", "LVV")) ????

Код

Sub SaveActiveSheetWithValuesAndFormats()
    Sheets("Consol").Select
    For i = 1 To 4
    Dim sh As Worksheet, wbNew As Workbook, cFileName
    Set sh = ActiveSheet
    cFileName = Application.GetSaveAsFilename(sh.Name, "Êíèãà Microsoft Office Excel (*.xls), *.xls")
    If cFileName = False Then Exit Sub
    Application.ScreenUpdating = False
    sh.Copy
    Set wbNew = ActiveWorkbook
    With wbNew.Sheets(1).UsedRange.Cells
        .Value = .Value
    End With
    Application.DisplayAlerts = False
    wbNew.SaveAs Filename:=(cFileName), FileFormat:=xlNormal
    wbNew.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Next i
    MsgBox "Ãîòîâî!"
End Sub

А если пишу так, то копирует все листы

Код

Sub SaveActiveSheetWithValuesAndFormats()
    Dim i As Integer
 For i = 1 To Sheets.Count
    Worksheets(i).Activate
    Sheets("Consol").Select
    Worksheets(i).Activate
    Set sh = ActiveSheet
    cFileName = Application.GetSaveAsFilename(sh.Name, "Êíèãà Microsoft Office Excel (*.xls), *.xls")
    If cFileName = False Then Exit Sub
    Application.ScreenUpdating = False
    sh.Copy
    Set wbNew = ActiveWorkbook
    With wbNew.Sheets(1).UsedRange.Cells
        .Value = .Value
    End With
    Application.DisplayAlerts = False
    wbNew.SaveAs Filename:=(cFileName), FileFormat:=xlNormal
    wbNew.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Next i
    MsgBox "Ãîòîâî!"
End Sub

Изменено: Ученик VBA - 29.09.2016 12:24:12

Перейти

Обединить два макроса VBA, Обединить два макроса (ручной и макрорекордер)

Ученик VBA

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

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

25.10.2015 14:31:15

Дорогой The_Prist
ThisWorkbook.Activate - подошло.

Работает !
Спасибо огромное, Золотко.

P/s: от 10 строчки и до конца тоже сокротю, как Вы говорите.
Извените, что заставила Вас такой долгий код читать: макрорекордер не такой умный как Вы, он пишет длинные коды

))

Перейти

Обединить два макроса VBA, Обединить два макроса (ручной и макрорекордер)

Ученик VBA

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

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

25.10.2015 13:46:16

Доброго дня!
Помогите ПОЖАЛУЙСТА обеденить 2 макроса:
1 - Макрос по созданию новой книги с 1 листом (списала с Вашего форума)
2-Макрос, записаный через макрорекордер, копитует данные с основной книги "ОБОРОТКА -10.2015 - копия.xls" в новую.
Код работает, но при переименовании рабочей книги, в которой он записан("ОБОРОТКА -10.2015 - копия.xls") - нет.
Так понимаю, у тексте макроса нужно поменять
Windows("ОБОРОТКА - 10.2015 - копия.xls").Activate
на Workbook.Activate
Когда меняю - выдает ошибку Run-time error 424. Помогите! Что нужно писать ???

Код

Sub Макрос7()
Dim New_Wb As Workbook
Set New_Wb = Workbooks.Add
New_Wb.Activate
New_Wb.SaveAs ("C:\Users\Kurinna\Desktop\макрос Нова книга\" & "НКА станом на " & Format(Date, "dd.mm.yyyy") & ".xlsx")
New_Wb.Application.ScreenUpdating = False
New_Wb.Application.DisplayAlerts = False
New_Wb.Application.SheetsInNewWorkbook = 1 'Количество листов в новой книге
New_Wb.Activate
Windows("ОБОРОТКА - 10.2015 - копия.xls").Activate
Columns("BD:BQ").Select
    Selection.Copy
    New_Wb.Activate
    ActiveSheet.Paste
    Windows("ОБОРОТКА - 10.2015 - копия.xls").Activate
    Range("BE5:BE19").Select
    Application.CutCopyMode = False
    Selection.Copy
    New_Wb.Activate
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("C:C").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Windows("ОБОРОТКА - 10.2015 - копия.xls").Activate
    Range("BG1").Select
    Selection.Copy
    New_Wb.Activate
    Range("D1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("F:F").Select
    Selection.EntireColumn.Hidden = True
    Range("G3:H3").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Windows("ОБОРОТКА - 10.2015 - копия.xls").Activate
    Range("BO6:BO10").Select
    Selection.Copy
    New_Wb.Activate
    Range("L6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("ОБОРОТКА - 10.2015 - копия.xls").Activate
    ActiveWindow.SmallScroll Down:=6
    Range("BO12:BO15").Select
    Application.CutCopyMode = False
    Selection.Copy
    New_Wb.Activate
    ActiveWindow.SmallScroll Down:=9
    Range("L12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("ОБОРОТКА - 10.2015 - копия.xls").Activate
    ActiveWindow.SmallScroll Down:=6
    Range("BN20:BN21").Select
    Application.CutCopyMode = False
    Selection.Copy
    New_Wb.Activate
    ActiveWindow.SmallScroll Down:=6
    Range("K20").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("ОБОРОТКА - 10.2015 - копия.xls").Activate
    Range("BO20:BO22").Select
    Application.CutCopyMode = False
    Selection.Copy
    New_Wb.Activate
    Range("L20:L22").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("ОБОРОТКА - 10.2015 - копия.xls").Activate
    ActiveWindow.SmallScroll Down:=6
    Range("BN27:BN29").Select
    Application.CutCopyMode = False
    Selection.Copy
    New_Wb.Activate
    ActiveWindow.SmallScroll Down:=9
    Range("K27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("ОБОРОТКА - 10.2015 - копия.xls").Activate
    Range("BO27:BO30").Select
    Application.CutCopyMode = False
    Selection.Copy
    New_Wb.Activate
    Range("L27:L30").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("ОБОРОТКА - 10.2015 - копия.xls").Activate
    ActiveWindow.SmallScroll Down:=6
    New_Wb.Activate
    ActiveWindow.SmallScroll Down:=-27
    Columns("A:C").Select
    Selection.EntireColumn.Hidden = True
    Rows("1:107").Select
    Range("D1").Activate
    Selection.RowHeight = 15.75
    Rows("1:107").EntireRow.AutoFit
    ActiveWindow.SmallScroll Down:=-102
    Rows("7:7").Select
    Range("D7").Activate
    With ActiveWindow
        .Width = 1004.25
        .Height = 393
    End With
    Selection.RowHeight = 24.75
    Rows("9:9").Select
    Range("D9").Activate
    Selection.RowHeight = 26.25
    Rows("12:14").Select
    Range("E12").Activate
    Rows("12:14").EntireRow.AutoFit
    Rows("15:15").Select
    Range("D15").Activate
    Selection.RowHeight = 26.25
    ActiveWindow.SmallScroll Down:=-15
    Range("D1").Select
    End Sub

Перейти