Как скопировать данные вставки на основе некоторых критериев из одной книги в другую (указать c ячеек) с помощью VBA?

Question

Я написал ниже код для копирования данных из одной книги, чтобы указать c ячеек в другой книге (это проблема, я думаю, в целевом файле есть месяцы и соответствующие данные под ним, каждый месяц мне нужно копировать данные в столбец текущего месяца, поэтому использовалась функция «последний столбец», чтобы не перезаписывать исторические месяцы, а также сделать его динамическим с c до go до последнего столбца, где нет данных за текущий месяц). Несмотря на то, что код работает нормально, я хочу оптимизировать его, чтобы облегчить отладку и избежать проблем в будущем, когда, например, текущий год изменился. У вас есть идеи, как я могу улучшить этот код ?

Код

Dim  x, LastRow, LastColumn, workfile, sourcefile As String
 
 sourcefile = ActiveWorkbook.Name
 workfile = ThisWorkbook.Name


LastRow = Range("A" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1
If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001B" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "GBP" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(28, 21).End(xlToLeft).Column + 1 
    Workbooks(workfile).Worksheets("A").Cells(28, Lastcolumn2).PasteSpecial xlPasteValues
Else

End If

If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001R" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "GBP" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn3 = Workbooks(workfile).Worksheets("A").Cells(29, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(29, Lastcolumn3).PasteSpecial xlPasteValues
Else
End If

If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001B" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "EUR" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn4 = Workbooks(workfile).Worksheets("A").Cells(35, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(35, Lastcolumn4).PasteSpecial xlPasteValues
    Else
    End If
    
If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001R" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "EUR" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn5 = Workbooks(workfile).Worksheets("A").Cells(36, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(36, Lastcolumn5).PasteSpecial xlPasteValues
    Else
    End If
    Next

Answer 1

рабочий файл

Итак, это скриншот «рабочего файла», из которого мне нужно каждый месяц копировать данные в соответствующий столбец месяца. Влияние скорости изменения области только формулы и расчет. Итак, скопированы - это до этого: пустые столбцы, в настоящее время начиная с августа, bcoz Я запускал его уже в июле, как я сказал, он работает, но код кажется слишком сложным и трудным для отладки для другого человека

Answer 2

LastRow = Range ("A" & Rows.Count) .End (xlUp) .Row For x = LastRow To 1 Step -1 'сохраните значения, которые вы хотите проверить, в этих двух переменных xrate1 = Workbooks (исходный файл) .Worksheets («exchangengedownload»). Cells (x, 1) .Value xrate2 = Workbooks (sourcefile) .Worksheets («exchangengedownload»). Cells (x, 2) .Value

' determine the value for targetRow in this Case statement
Select Case xrate2
    Case "GBP"
Select Case xrate1
    Case "001B": targetrow = 28
Case Else: targetrow = 29
End Select
Select Case xrate2
    Case "EUR"
Select Case xrate1
    Case "001B": targetrow = 35
 Case Else: targetrow = 36
End Select

' copying data
Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
Workbooks(workfile).Worksheets("A").Activate
Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(targetrow, 21).End(xlToLeft).Column + 1
Workbooks(workfile).Worksheets("A").Cells(targetrow, Lastcolumn2).PasteSpecial xlPasteValues

Next

Выше - скорректированный, поскольку я не мог использовать оператор If с Case, Case заменяет If, Elseif. Но по-прежнему появляется ошибка компиляции, в которой говорится, что это «Далее без For» и «Завершить выбор без оператора Case» ((

Answer 3

@ NigarHuseynzade Добро пожаловать в Stackoverflow. Все, что вам нужно сделать, это определить целевую строку для каждого из ваших условий, а затем просто вставить это значение в блок кода, который вы хотите выполнить. Таким образом, вы избавитесь от необходимости повторять один и тот же код несколько раз.

Вот как вы это сделаете:

Dim  x, LastRow, LastColumn, workfile, sourcefile, exchangedownload1, exchangedownload2 As String
Dim targetRow As Integer

sourcefile = ActiveWorkbook.Name
workfile = ThisWorkbook.Name

LastRow = Range("A" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1

    ' store the values you are wanting to examine in these 2 variables
    exchangedownload1 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value
    exchangedownload2 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value

    ' determine the value for targetRow in this Case statement
    Select Case exchangedownload2
        Case Is "GBP"
            If exchangedownload1 = "001B" Then
                targetRow = 28
            ElseIf enchangedownload1 = "001R" Then
                targetRow = 29
        Case Is "EUR"
            If exchangedownload1 = "001B" Then
                targetRow = 35
            ElseIf enchangedownload1 = "001R" Then
                targetRow = 36
    End Select

    ' this is your code block that was being repeated with just a 
    ' different value for your targetRow, so just plug the value for 
    ' targetRow where it belongs and you only have to have this code block once
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(targetRow, 21).End(xlToLeft).Column + 1 
    Workbooks(workfile).Worksheets("A").Cells(targetRow, Lastcolumn2).PasteSpecial xlPasteValues

Next

Пожалуйста, дайте мне знать, если это не сработает или вам нужно любая помощь в реализации этого, и я сделаю все, что могу, чтобы помочь.