Скопируйте диапазон отфильтрованных ячеек - PullRequest
0 голосов
/ 03 декабря 2018

У меня проблема с копированием данных из рабочей книги в другую.Основной файл main_sheet собирает данные из листа другой рабочей книги, которая меняет свое имя по месяцам и годам, поэтому в настоящее время Workbookdecember18 (он всегда защищен паролем).

Начиная с Workbookdecember18, я должен сначала отфильтровать столбец code по 0, а затем отсортировать столбец data3 от A до Z.Затем мне нужно скопировать первые 20 строк из data1, data2 и data3 в main_sheet из другой книги.

Это исходный лист Workbookdecember18:

This is the table

Это другая рабочая книга с main_sheet (в ней обычно будет только 20 строк):

enter image description here

Это код, который я написал, но он не работает:

Windows("Workbookdecember18").Activate
Sheets("1").Select
ActiveSheet.Unprotect
Range("A2").Select
Selection.AutoFilter
ActiveSheet.Range("$A$2:$CH$2402").AutoFilter Field:=1, Criteria1:="0"
Range("D3").Select
ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields _
    .Clear
ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields _
    .Add Key:=Range(D3"), SortOn:=xlSortOnValues, Order:=xlDescending, _
    DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("1").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Range("A2:D30").Select
Selection.Copy
Windows("Another workbook").Activate
Range("A2:D30").Select
ActiveSheet.Paste

Первая проблема заключается в том, что мне нужно заставить ее распознавать рабочую книгу, когда ее имя меняется каждый месяц изаставьте его выбрать 20 нужных мне строк (хотя последняя может быть в строке 200 после ее фильтрации).

1 Ответ

0 голосов
/ 03 декабря 2018

В течение следующих трех или четырех недель "Workbook" & Format(Date, "mmmmyy") должно выдать WorkbookDe декабря18 в региональном стандарте США-EN.

Option Explicit

Sub filterAndTransfer()
    Dim target As Range

    Windows("Another workbook").Activate

    With Worksheets("sheet1")
        Set target = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
    End With

    Windows("Workbook" & Format(Date, "mmmmyy")).Activate

    With Worksheet("1")
        .Unprotect
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, "A").CurrentRegion
            .Sort Key1:=.Cells(1, "D"), Order1:=xlDescending, DataOption1:=xlSortNormal, _
                  Orientation:=xlTopToBottom, Header:=xlYes
            .AutoFilter field:=1, Criteria1:=0
            .Offset(1, 0).Copy Destination:=target
        End With
        If .AutoFilterMode Then .AutoFilterMode = False
    End With

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...