Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 След.
Сохранение файла с нужным разделителем
 

Доброго времени суток форум,
Есть ощущение что тема совсем не новая... тем не менее.
Задача написать процедуру, которая из xlsm файла необходимы лист сохранит как CSV фиал на рабочем столе с разделитель как "~"
Спасибо всем кто отзовется.
Код
Sub SaveSheetToCSV()
    ActiveWorkbook.SaveAs Filename:="C:\Users\xyz\Desktop\combine.csv", FileFormat:=xlCSVUTF8, Local:=True, CreateBackup:=False
    ActiveWorkbook.Close SaveChanges:=False
End Sub
Трансформирование таблицы в PowerQuery. Перенос n значений из столбца в строку
 
Доброго всем дня,
Задача транформировать таблицу как указано в примере. Перенести значения из столбца в трочку.
Всех с наступающими праздниками!
Спасибо за поддержку!
Процедура на сравнение и строк в том же столбце с помощью power-query, power-query, m-code, power-bi
 

Привет дорогой форум,
Помогите пожалуйста написать процедуру на сравнение строчек в том-же поле/столбце.
Прикрепил файл с приблизительным примером. Оригинал выложить не могу (confidential).
Спасибо всем кот откликнется.

Показать в ячейке все значения из Table1 поочередно, vba
 
Доброго времени форум!
Помогите пожалуйста неписать короткую процедуру которая покажет поочередно все значения Table1 в ячейке D2
Спасибо всем кто отзовется!
Макрос для сохранение фала на OneDrive | SharePoint
 
Доброго всем дня,
Задача. Есть фиал CD_DB.xlsm. Сразу после открытия WorkBook должен создать своего клона и сохранить на OneDrive далее работа должна быть продолжена в initial файле (который только что был скоприрован). Пример кода ниже. Данный метод .SaveAsCopy работает если фаил находтся локально на машине. При попытке сохранить в облако выдает ошибку Run-Time error 1004. Application defined or object defined error.
Спасибо всем кто откликнется на помощь.
Код
'CodeLocation >> ThisWorkbook

Private Sub Workbook_Save()
    Dim ThisBook As Workbook
    Dim ws As Worksheet
    Dim copyName As String
    
    Set ThisBook = ThisWorkbook
    Set ws = ThisBook.Worksheets("cover")
    
    'file path connected to named range.
    'filepath5 = "https://xxx.sharepoint.com/personal/user_xxx/Documents/CA%20CZ%20Handover/Macro%20preparation/CA%20Tool/Archiving/CA_DB%20Backup%20210521133611.xlsm"
    
    copyName = ws.Range("filepath5") 
        
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
            If ThisBook.Name <> "CA_DB.xlsm" Then
                Exit Sub
                Else       
                ThisWorkbook.SaveCopyAs copyName
                ActiveWorkbook.Save
            End If
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    MsgBox "Backup for [CA_DB yyyy-mm-dd hhmmss.xlsm] has been created."
End Sub
Копировать из активной книги листы с синими ярлыками в новую книгу
 
Доброго времени суток.
Подскажите пожалуйста  как скопировать только "синие" листы в только что созднною книгу.
Ниже модуль который я подсмотрел и попытался докрутить... прошу о помощи.
Фаил прикреплен для наглядности.
Спасибо большое!
Консолидация / Сумирование данных с n-страниц и n-диапозонов, VBA, ConsolidateRangeArray
 

Доброго дня форум
Имеется вот такой код. Подскажите  пожалуйста как бы его оптимзировать. Я понимаю что он выглядит громоство и неуклюжо. Особенно когда надо добовлять листы или убирать, такая же история и с даипозонами.
Спасибо всем кто отзовется.
Код
Sub recap_data1()
Dim wbk As Workbook
Dim wsh As Worksheet
Dim trgtrng As Range
Dim ConsolidateRangeArray As Variant

Set wbk = Workbooks(Range("BookName").Value)
Set wsh = wbk.Worksheets("Recap")
Set trgtrng = wsh.Range("D12")

  ConsolidateRangeArray = Array("5220!R12C4:R14C8", "400E!R12C4:R14C8", _
                                "4124!R12C4:R14C8", "552E!R12C4:R14C8", _
                                "5304!R12C4:R14C8", "539D!R12C4:R14C8", _
                                "5706!R12C4:R14C8", "5356!R12C4:R14C8", _
                                "4349!R12C4:R14C8", "546E!R12C4:R14C8", _
                                "4187!R12C4:R14C8", "5255!R12C4:R14C8", _
                                "5286!R12C4:R14C8", "5244!R12C4:R14C8", _
                                "5975!R12C4:R14C8", "546P!R12C4:R14C8", _
                                "443x!R12C4:R14C8", "4104!R12C4:R14C8", _
                                "5300!R12C4:R14C8", "527P!R12C4:R14C8", _
                                "504N!R12C4:R14C8", "503N!R12C4:R14C8", _
                                "502B!R12C4:R14C8", "5985!R12C4:R14C8", _
                                "5355!R12C4:R14C8", "442N!R12C4:R14C8", _
                                "4721!R12C4:R14C8")

    trgtrng.Consolidate Sources:=ConsolidateRangeArray, Function:=xlSum
End Sub

Разбить/разделить таблицу по условию с помощьюPowerQuery, PowerQuery, Split
 
Доброго времени суток форум.

Подскажите пожалуйста, как можно реализовать разбивку таблицы по условию. Пример в приложении.
Прошу не судить строго за название темы. Спасибо всем кто отзовется.
Изменено: Alex D - 24.11.2020 20:30:54
Как решить Error: “DataSource.NotFound: File or Folder: We couldn't find the folder”, Power Query
 

Доброго дня,

Подскажите пожалуйста. Есть ли возможно остановить Query при условии что data sours (фаил или пусть к файлу) отсутствуют?
Идеалным в таком случае было бы выгрузить напимер пустую строку и продолжить со следующим Query.

Спасибо за консультацию.

Поиск значения из нужного столбца INDEX, MATCH, Excel, Formula, INDEX, MATCH
 
Здравствуйте,
Подскажите пожалуйста, как можно взять знаячения из нужного столбца?
Формула INDEX MATCH возвращяет значение только из указанного столбца сейчас.
Фаил прикреплен.
Спасибо.
PQ: Извлечение текста из строки по условию / Работа с текстом, Power Query
 
Доброго времени суток.

Подскажите пожалуйста как с помощью PQ можно извлеч текст.
Пример в приложении.

Спасибо.
Автозаполнение чередующихся значение со сдвигим вниз до последнего заполненого ряда
 
Здравствуйте,

Есть вот  такой код. Вносятся данные по условию и потом протягиваются. Трудность возникает когда данных для заполнения <=4 строк.
Ошибка. "Run-time Error 1004. Autofill Method of Range Class Failed”.
"On Error GoTo" Пробовал, немного не подходит.

Как это можно написать код, более "правильно". Включать голову пробовал.:)
Фаил на всякий случай прикрепил.
Спасибо и берегите себя!

Название темы: Автозаполнение чередующихся значение со сдвигим вниз до последнего заполненого ряда.
Код
Sub automatic_data_population()
    Sheets("Sheet1").Activate

    Sheets("Sheet1").Range("C11").FormulaR1C1 = "S"
    Sheets("Sheet1").Range("C12").FormulaR1C1 = "H"
    Sheets("Sheet1").Range("C13").FormulaR1C1 = "=R[-2]C"
    Sheets("Sheet1").Range("C14").FormulaR1C1 = "=R[-2]C"
    Sheets("Sheet1").Range("C13:C14").AutoFill Destination:=Range("C13:C" & Range("D" & Rows.Count).End(xlUp).Row)

    Sheets("Sheet1").Range("B11").FormulaR1C1 = "66815500"
    Sheets("Sheet1").Range("B12").FormulaR1C1 = "69141000"
    Sheets("Sheet1").Range("B13").FormulaR1C1 = "=R[-2]C"
    Sheets("Sheet1").Range("B14").FormulaR1C1 = "=R[-2]C"
    Sheets("Sheet1").Range("B13:B14").AutoFill Destination:=Range("B13:B" & Range("D" & Rows.Count).End(xlUp).Row)
End Sub
Как сделать адрес диапозона переменным/динамичным, VBA
 
Доброго времени суток.

Прошу прощения за топорную формулировку впроса. Есть вот такой фаил.
Когда меняесться переменная в значение в ячейке "F2", таким образом мы выбираем какие колонки копировать из Sheets("data")
Вопрос. Как сделать это динамичным?

Фаил приложен.
Будте здорово и спасибо!
Код
Sub test()
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet

        Set wsCopy = Sheets("data")
        Set wsDest = Sheets("cover")
        
        Sheets("data").Activate
        
            'Сейчас работает так:
            wsCopy.Range(Range("A:A"), Range("A:A").End(xlDown)).Copy wsDest.Range("K:K")
            wsCopy.Range(Range("D:D"), Range("D:D").End(xlDown)).Copy wsDest.Range("L:L")
            wsCopy.Range(Range("F:F"), Range("F:F").End(xlDown)).Copy wsDest.Range("M:M")
            
            'Примерно нужно вот такое:
            'wsCopy.Range(Range(Range("range_1").Value), Range(Range("range_1").Value).End(xlDown)).Copy wsDest.Range("K:K")
            'wsCopy.Range(Range(Range("range_2").Value), Range(Range("range_2").Value).End(xlDown)).Copy wsDest.Range("L:L")
            'wsCopy.Range(Range(Range("range_3").Value), Range(Range("range_3").Value).End(xlDown)).Copy wsDest.Range("M:M")
            
        Sheets("cover").Activate
End Sub
Удаление столбцов с CHAR(10) в названии
 
Добрый день,
С праздником 1 мая! Сразу скажу, что название темы не совсем соответсвует моему вопросу. Не знаю как его сформулировать верно.
Макрос удяляет столбцы которые не нужны. Впрос. Что делать если название одной из колонок имеет вид ->> "Column" & CHAR(10) & "4". ->> (макрос ее не удоляет). Как это можно сделать?
Спасибо.


Код
Sub delete_Irrelevant_Columns()
    Dim keepColumn As Boolean
    Dim currentColumn As Integer
    Dim columnHeading As String

    currentColumn = 1
    While currentColumn <= ActiveSheet.UsedRange.Columns.Count
        columnHeading = ActiveSheet.UsedRange.Cells(9, currentColumn).Value

        keepColumn = True
        If columnHeading = "Column1" Then keepColumn = False
        If columnHeading = "Column2" Then keepColumn = False
        If columnHeading = "Column3" Then keepColumn = False
        If columnHeading = "Column" & CHAR(10) & "4" Then keepColumn = False

        If keepColumn Then
            currentColumn = currentColumn + 1
        Else
            ActiveSheet.Columns(currentColumn).Delete
        End If

        If (ActiveSheet.UsedRange.Address = "$A$1") And (ActiveSheet.Range("$A$1").Text = "") Then Exit Sub
    Wend
End Sub
Изменено: Alex D - 01.05.2020 13:45:17
Удалить/заменить значения только в нужных столбцах и тех которые начинаются на указанное слово
 
Доброго времени суток

Подскажите пожалуйста, что не так делаю? Есть вот такой макрос. Задача удалить/заменить знечения (указвны в коде) только в нужных столбцах и имеен тех которые начинаются на [Week & "*"].

Спасибо всем кто отзовется.
Всем здоровья

Вот так работает... прости что спамлю...
Код
Sub test()
    Dim rng As Range
    Dim cell As Range
    Dim xWs As Worksheet
                            
        For Each xWs In Application.ActiveWorkbook.Worksheets
            If xWs.Name = "Sheet1" Then
                For Each lo In xWs.ListObjects
                    For Each lc In lo.ListColumns
                        If lc.Name Like "Week " & "*" Then
                            lc.DataBodyRange.Replace What:="[*]", Replacement:=""
                            lc.DataBodyRange.Replace What:=" ", Replacement:=""
                        End If
                    Next lc
                Next lo
            End If
        Next xWs
End Sub
Изменено: Alex D - 24.04.2020 21:51:49
Подсчитать количество непустых ячеек в динамическом диапазне
 
Здравствуйте.

Есть макрос ниже. Также имеются данные в умной таблице. Этим макросом находим последний пустой стоблец. Прописываем название столбца и ставим формулу.
Вопрос. Как учесть момен, если количество столбцов постоянно меняется?

Всем здоровья!
Спасибо.
Код
Sub test()
    Sheets("Sheet1").Activate
    NewCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1
    Cells(1, NewCol).Value = "f(x)"
    
    lastrow = ActiveSheet.Cells(Rows.Count, NewCol).End(xlUp).Row + 1
    Cells(2, NewCol).Formula = "=COUNTA(RC[-17]:RC[-1])" '<--Количество столбцов меняется
End Sub
Создать список всех объектов/областей с референцией на лист где объект/область находятся., VBA, macor
 

Возникла задача создать таблицу.
В таблице нужно показать данные (имя) по всем обектам/облостям, и на каком листе объект/область находится?
Может быть есть решение по такой задачи?

Оставайтесь дома и берегите близких.
Спасибо за консультацию.

Пример
ObjectName | SheetName
tbl_1            | List 1
tbl_2            | List 2
tbl_3            | List 3
Создание рамок с n - повторением с интервалом в 10 строк для отчета.
 
Доброго дня,

Надеюсь мое сообщение найдет Вас в добром здравии.
Стоит задача создать рамки с n - повторением. n - повторение через каждые 10 строчек. Так же это зависит от того где последняя заполненная строка.
Пример в приложении
Спасибо большое и берегите себя!
Код
Sub test()
Worksheets("Sheet1").Range("B6:H15").BorderAround _
    ColorIndex:=3, Weight:=xlThick
    
Worksheets("Sheet1").Range("B16:H25").BorderAround _
    ColorIndex:=3, Weight:=xlThick
    
Worksheets("Sheet1").Range("B26:H35").BorderAround _
    ColorIndex:=3, Weight:=xlThick
End Sub

Sub clear()
Worksheets("Sheet1").Range("B6:H100").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub
Изменено: Alex D - 23.03.2020 14:21:17
Удаление столбцов в умной таблице, vba, macro
 

Доброго дня,
Подскажите пожалуйста как можно удалить все колоники начишающиеся с "Column"?
Поиски привели меня вот к чему.

Код
Sub delete_columns()
    Dim xWs As Worksheet
    Dim lo As ListObject
    
    Set xWs = ActiveSheet
    Set lo = xWs.ListObjects(1)
    
        For Each Cell In lo
            If Cell.Value = "Column*" Then loTable.ListColumns(1).Delete
        Next
End Sub
Изменено: Alex D - 03.03.2020 20:36:03
Объединенить / СЦЕПИТЬ ячееки в умной таблице, macro, vba
 
Только тут могут помочь, направить.
Задача. Сцепить ячейки в умной таблице. Данные нужно сцепить между двумя колонками. Start и End. Позиция  End колонки постоянно меняется от листа к листу. Данные нужно вывести в колонку Start.  Пример прикреплен. Там есть корявенький макрос. Пытался что-то придумать.
Спасибо и хороших выходных!
Фильтрация таблицы и удаление отфильтрованых строк, VBA, macro
 
Доброго день,

Есть вот такой код. Что сделать, что бы не удалялись вся таблица. Пример в приложении.
Спасибо.
Код
Sub delete_rule_2()
    Dim xWs As Worksheet
    Dim lo As ListObject
    Dim iCol As Long
    
    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "cover" And xWs.Name <> "mapping" Then
        xWs.Activate

        Set lo = ActiveSheet.ListObjects(1)
        iCol = lo.ListColumns("ABCD").Index
                    
        On Error Resume Next
        lo.AutoFilter.ShowAllData
            With lo.Range
            .AutoFilter Field:=iCol, Criteria1:="X" 'Проблема, тут. Как только этого знаяения нет в колонке, удаляются все строки где его нет. Как поправить?
                If lo Is Nothing Then
                    End
                    Else
                    lo.DataBodyRange.EntireRow.Delete
                    lo.AutoFilter.ShowAllData
                End If
            End With
        End If
    Next xWs
    
End Sub
VBA. Фильтрация данных по уловию на другом листе
 
Здравствуйте,
Подскажите что делать (фаил прикреплен).
Хочу отфильтровать данные по условию на Листе 2, Данные фильтруються на Листе 1 в колонке А. Фильтр выдает лишние строки.
Подскажите пожалуйста, как поправить?
Сапсибо!
Изменено: Alex D - 12.02.2020 21:17:38
Открытие, обновление ссылок/связей, сохрание и закрыте для n+1 файлов с помощью VBA на SharePoint, vba
 
Доброго дня.
Только тут могут помочь. Есть вот такой код. Задача, стоит такая:
1) Открыть фаилы уложенные на  SharePoint
2) Обновить связи/ формулы
3) Сохранить
4) Закрыть
5) Следубющий фаил

Ошибка возникает вот в этой строке.
Код
source_file = TempPath & StrFile & ".xlsx"

@Модераторы, возможно вопрос не по теме форума. Если так, дайте знать.
Спасибо большое, кто отзовется.
Код
Sub update_files()
    Dim FolderPath As String
    Dim wb_master As Workbook
    Dim ws_master As Worksheet
    Dim StrFile As String
    Dim TempPath As String
    Dim source_wb As Workbook

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.AskToUpdateLinks = False

    If wb_master Is Nothing Then Set wb_master = ThisWorkbook
    If ws_master Is Nothing Then Set ws_master = ThisWorkbook.Sheets("setup")

    FolderPath = ws_master.Range("A5") 'cell "A5" = https://customer_name.sharepoint.com/teams/BG003C9/FY20/08/Actuals/01/Preliminary/Actuals/

    TempPath = Replace(Replace(FolderPath, "https://customer_name.sharepoint.com", "\\customer_name.sharepoint.com@SSL\DavWWWRoot\"), "/", "\")

    If ws_master.AutoFilterMode = True Then ws_master.AutoFilterMode = False
        SourceRow = 5
                    Do While Cells(SourceRow, "B").Value <> "" 'cell B5 ... Bn+1 until cell = "", stored file name on customer SharePoint
                        StrFile = ws_master.Range("B" & SourceRow).Value

                            source_file = TempPath & StrFile & ".xlsx"
                            Set source_wb = Workbooks.Open(source_file)
                                source_wb.LockServerFile 'locke file on server for next changes
                                source_wb.Activate 'active opend file
                                source_wb.UpdateLink Name:=ActiveWorkbook.LinkSources 'update all links
                                source_wb.Save 'save workbook
                                source_wb.Close 'close workbook
                            SourceRow = SourceRow + 1 ' Move down 1 row for source sheet
                        Loop
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.AskToUpdateLinks = True
End Sub
Изменено: Alex D - 11.02.2020 15:49:44
Выделение видимого диапазона по условию, vba, macor
 

Доброго дня.
Частично вопрос относится в этой теме: “Почему ошибка "Compile error. Object required", VBA, Error”
Помогите пожалуйста разобраться вот в таком коде. Зада "начать" выделять диапазон в соответствии со значениями строки и колонки. Файл прикрепил. Синем цветов (a, b) соответственно определяемая строка и колонка.

Спасибо большое.

Код
Sub test()
    Dim lastrow As Long
    Dim c As Range
    Dim rng As Range
    
    With ThisWorkbook.Worksheets("Sheet2")
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For Each c In .Range("A1:A" & lastrow)
            If (c.Text) = "a" Then 'find this value in row
                If rng Is Nothing Then
                    Set rng = .Range("A" & c.Row).Resize(, 12) '12 = L column
                End If
            End If
        Next c
    End With
    If Not rng Is Nothing Then rng.Select
    Range(Selection, Selection.End(xlDown)).Select 'now selected all rows till the end of worksheet, but need to select viseble row
End Sub
Почему ошибка "Compile error. Object required", VBA, Error
 
Доброго дня,
Подскажите пожалуйста почему ошибка "Compile error. Object required"?
Спасибо.
Код
Sub macro_1()            
Dim myrange As Range
Dim lastrow As Integer
Dim my_sh As Worksheet
Dim my_wb As Workbook
                
 Set my_wb = ThisWorkbook
 Set my_sh = ThisWorksheet.Worksheet("supp_sheet")
    
 Set lastrow = my_sh.Cells(Rows.Count, 1).End(xlUp).Row
 Set myrange = my_sh.Range("A1:X" & lastrow).Select
End Sub

Автоматическое обновление связей / данных, файлов хронимых на sharepoint, vba, macro
 
Доброго дня,
Подскажиет пожалуйста. Как обновить связи без всплывающенго сообщения?
Что делаю не так?
Спасибо.
Код
Sub test_2()
Dim sFile As String
Dim wb As Workbook
Dim FileName As String
Dim wksSource As Worksheet

    Const scWkbSourceName As String = "test"
    Const sPath As String = "test"
    
    Set wkbSource = Workbooks(scWkbSourceName)
    Set wksSource = wkbSource.Sheets("Setup")

    SourceRow = 6 'start from this row
            Do While Cells(SourceRow, "B").Value <> ""
                FileName = wksSource.Range("B" & SourceRow).Value
                    sFile = sPath & FileName
                    Set wb = Workbooks.Open(sFile)
                        wb.LockServerFile
                        wb.Activate
                        wb.UpdateLink Name:=ActiveWorkbook.LinkSources 'тут появляется сообщение
                        wb.Save
                        wb.Close
    SourceRow = SourceRow + 1
            Loop
End Sub
Изменено: Alex D - 21.01.2020 15:32:18
Настройка переменного значение критерия/фильтра в умных таблицах, vba, macro
 
Доброго времения суток.

Имеется, вот такой простенький макрос. Он фильтрует данные по логическому условию. IF TRUE = "2" , IF FALSE  = "<>2"
Вопрос. Как научить критерий понимать IF FALSE = "<>2"

Спасибо.
Код
Sub step_6()        
Application.DisplayAlerts = False
Application.ScreenUpdating = False
        
Dim ws As Worksheet
Dim filterColumn As String
Dim lo As ListObject
  On Error Resume Next
  
Worksheets("ex_types").Activate
   Set ws = ActiveSheet
   Set lo = ws.ListObjects(1)
     
lo.AutoFilter.ShowAllData
filterColumn = ActiveWorkbook.Sheets("cover").Range("Y21") 'в этой ячейке стоит логическая формула => IF TRUE = "2" IF FALSE "<>2"
ws.ListObjects("tbl_ex_types").Range.AutoFilter Field:=3, Criteria1:=filterColumn 
End Sub
Фильтрация таблицы с помошью расширенного фильтра
 
Доброго дня,
Подскажите пожалуйста, в чем ошибка? Пытаюсь отфильтровать данные с .AdvancedFilter  Колличесво критериев по которым нужно отфильтровать, >1, max 25.
Спасибо.
Код
Sub step_9()
Worksheets("tbl_input").Activate
    
Range("tbl_input[#All]").AdvancedFilter Action:=xlFilterInPlace, _
    CriteriaRange:=ActiveWorkbook.Sheets("ex_types").Range("B25:B" & Range("B" & Rows.Count).End(xlUp).Row), Unique:=False 'тут выдает ошибку.
    'CriteriaRange:=ActiveWorkbook.Sheets("ex_types").Range("B25:B37"), Unique:=False 'a вот так, работает.
End Sub
Фильтрация данных по условию в ячейке, vba, macro
 

Здравствуйте,

Подскажите как можно сделать вот такое.

List1 - Выберается период от P01 до P16
List3 - Отфильтровывается соответствующий период, если ячейка  = "x"
List2 – Вспомогательный лист

Фиал прикреплен.

С темой сообщения не уверен. Прошу простить.

Код
Sub test()
Dim ws As Worksheet
Dim filterColumn As Integer

        Set ws = ActiveSheet
        filterColumn = ActiveWorkbook.Sheets("cover").Range("A2").Value

        ws.ListObjects("Table1").Range.AutoFilter Field:=filterColumn, Criteria1:="<>"
End Sub

Спасибо всем кто отзовется.

Изменено: Alex D - 07.01.2020 18:34:45
Сборка данных с листов определенного цвета в одну таблицу., vba, macro, data consolidation
 
Доброго дня,

Подскажите пожалуйста что не так...? Задача собарть все данные в одну таблицу. Усолвие, сбор данных если цвет листа RGB(238, 236, 225), серый.  Фаил прикреплен.
Спасибо всем кто отзовется.
Хорошего дня.
Код
Sub all_data()
Dim ws As Worksheet
        For Each ws In ThisWorkbook.Worksheets
        If ws.Tab.Color = RGB(238, 236, 225) Then
            ws.Activate
                
                'lastrow = ThisWorkbook.ActiveSheet.Cells(Row.Count, 1).End(xlUp).Row
                lastrow = ThisWorkbook.ActiveSheet.Cells(Row.Count, 1).End(xlUp).Row
                    For J = 5 To lastrow
                    ThisWorkbook.ActiveSheet.Activate
                    ThisWorkbook.ActiveSheet.Row(J).Select
                    Selection.Copy
                    Worksheets("Upload_V8xx").Activate
                    
                    Worksheets("Upload_V8xx").Activate
                    lastrow = Worksheets("Upload_V8xx").Cells(Rows.Count, 1).End(xlUp).Row
                    Worksheets("Upload_V8xx").Activate.Cells(lastrow + 1, 1).Select
                    ActiveSheet.Paste
                    Next
        End If
    Next ws
End Sub
Страницы: 1 2 3 След.
Наверх