Как применить макрос только к выбранной строке - PullRequest
0 голосов
/ 14 апреля 2019

Я действительно новичок в МакКросе.Я сделал один, используя автоматическую запись, но я не могу использовать его только для выбранной строки, он продолжает делать это в той же строке, что и запись.Мне очень нужна ваша помощь, чтобы решить ее, и помочь мне лучше понять, как на самом деле работает maccros

Мой макрос выглядит следующим образом:

Sub COPIERVALEURS()
'
' COPIERVALEURS Macro
'
' Touche de raccourci du clavier: Ctrl+Shift+V
'

    Range("A34:H34").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks     _
        :=False, Transpose:=False
    Range("M34:N34").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("K34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks     _
        :=False, Transpose:=False
    Range("S34:T34").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("Q34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks     _
        :=False, Transpose:=False
    Range("Y34:Z34").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("W34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks     _
        :=False, Transpose:=False
    Range("AE34:AF34").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AC34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks     _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll ToRight:=5
    Range("AI34:AJ34").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AG34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks     _
        :=False, Transpose:=False
    Range("AK34").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks     _
        :=False, Transpose:=False
End Sub

Ответы [ 2 ]

0 голосов
/ 16 апреля 2019

Спасибо, ошибка 1004, это мне очень помогло, окончательный код теперь, как показано ниже, и работает отлично, благодаря вам:

Option Explicit

Sub COPIERVALEURS()

' COPIERVALEURS Macro
' Touche de raccourci du clavier: Ctrl+Shift+V

    Dim RowNo As Long

    With ThisWorkbook.Worksheets("PAQ")

        RowNo = Selection.Row '<- Here you get the row number you have select

        .Range("A" & RowNo & ":H" & RowNo).Copy
        .Range("A" & RowNo & ":H" & RowNo).PasteSpecial Paste:=xlPasteValues
        .Range("M" & RowNo & ":N" & RowNo).Copy
        .Range("K" & RowNo).PasteSpecial Paste:=xlPasteValues
        .Range("S" & RowNo & ":T" & RowNo).Copy
        .Range("Q" & RowNo).PasteSpecial Paste:=xlPasteValues
        .Range("Y" & RowNo & ":Z" & RowNo).Copy
        .Range("W" & RowNo).PasteSpecial Paste:=xlPasteValues
        .Range("AE" & RowNo & ":AF" & RowNo).Copy
        .Range("AC" & RowNo).PasteSpecial Paste:=xlPasteValues
        ActiveWindow.SmallScroll ToRight:=5
        .Range("AI" & RowNo & ":AJ" & RowNo).Copy
        .Range("AG" & RowNo).PasteSpecial Paste:=xlPasteValues
        .Range("AK" & RowNo).Copy
        .Range("AK" & RowNo).PasteSpecial Paste:=xlPasteValues

    End With

End Sub
0 голосов
/ 15 апреля 2019

Я пытаюсь понять вашу логику, чтобы помочь вам как можно больше. Выберите строку, в которой этот код должен действовать, импортируйте точку останова в строке С , выполните и отладьте код, чтобы увидеть, соответствует ли он вашим требованиям. Для выбора строки нажмите на номер каждой строки слева от вас.

Код:

Option Explicit

Sub test()

    Dim RowNo As Long

    With ThisWorkbook.Worksheets("Sheet1")

        RowNo = Selection.Row '<- Here you get the row number you have select

        .Range("M" & RowNo & ":N" & RowNo).Copy '<- Copy range M:N of the RowNo you have selct
        .Range("K" & RowNo).PasteSpecial Paste:=xlPasteValues '<- Paste in Column K row the one tou have select

        .Range("S" & RowNo & ":T" & RowNo).Copy
        .Range("Q" & RowNo).PasteSpecial Paste:=xlPasteValues

        .Range("Y" & RowNo & ":Z" & RowNo).Copy
        .Range("W" & RowNo).PasteSpecial Paste:=xlPasteValues

        .Range("AE" & RowNo & ":AF" & RowNo).Copy
        .Range("AC" & RowNo).PasteSpecial Paste:=xlPasteValues

        .Range("AI" & RowNo & ":AJ" & RowNo).Copy
        .Range("AG" & RowNo).PasteSpecial Paste:=xlPasteValues

        Application.CutCopyMode = False

    End With

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