Vba 我很确定有些元素有一个简单的方法，但对我来说很有效！ 谢谢你的提示，我从中挑选了一些这样或那样的东西，因此我将投票支持Hessr17。我可以多次看到你的代码在做一些事情，但是每个循环中会发生什么变化？你可能想把它包装成一个子函数，只需给它传递不同的参数。我

我很确定有些元素有一个简单的方法，但对我来说很有效！

---

谢谢你的提示，我从中挑选了一些这样或那样的东西，因此我将投票支持Hessr17。

我可以多次看到你的代码在做一些事情，但是每个循环中会发生什么变化？你可能想把它包装成一个子函数，只需给它传递不同的参数。我在谷歌上搜索了“Boucle For”，所有结果都是法语。“Boucle”是“Loop”法语。正如Google translate告诉我的那样。你可以删除你的许多

。选择
和
选择。
通过组合它们，即
cellle.Copy
我可以看到你的代码多次执行某些操作，但每个循环中会发生什么变化？你可能想把它包装成一个子函数，只需给它传递不同的参数。我在谷歌上搜索了“Boucle For”，所有结果都是法语。“Boucle”是“Loop”法语。正如Google translate告诉我的。你可以删除你的许多
.Selects
和
选择。
通过组合它们，即
cellle.Copy
我的第一个cellle有一个错误。Select（错误1004类范围的方法选择失败）我的第一个cellle有一个错误。Select（错误1004类范围的方法选择失败）
Sheets("Clients").Select 
Range("A7").Select
Selection.Copy 
Sheets("DB TEMP").Select 
Range("A2:A13").Select
ActiveSheet.Paste
Sheets("Clients").Select
Range("B7,D7,F7,H7,J7,L7,N7,P7,R7,T7,V7,X7").Select
Selection.Copy
Sheets("DB TEMP").Select
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

Dim Cellule As Range
Dim Feuille As Worksheet

Sheets("Clients").Select

For Each Cellule In Range("A1:A260")         'For all cells in the column A

    If Cellule <> "" Then         '#if the cell is not null
        Cellule.Select            '#select the cell (if possible to select the adjacent one too in B
        Selection.Copy            '#copy it 
        Sheets("DB TEMP").Select  '#go to other sheets
        With Sheets("DB TEMP")    '#go find the last row available in column A        
            LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        End With
        ActiveSheet.Paste         '#paste the data   

        Sheets("Clients").Select  '#Back in my main sheets



        Range(Cells(Cellule.ActiveCell.Row, B), Cells(Cellule.ActiveCell.Row, D), Cells(Cellule.ActiveCell.Row, F), Cells(Cellule.ActiveCell.Row, H), Cells(Cellule.ActiveCell.Row, J), Cells(Cellule.ActiveCell.Row, L), Cells(Cellule.ActiveCell.Row, N), Cells(Cellule.ActiveCell.Row, P), Cells(Cellule.ActiveCell.Row, R), Cells(Cellule.ActiveCell.Row, T), Cells(Cellule.ActiveCell.Row, V), Cells(Cellule.ActiveCell.Row, X)).Select



            Selection.Copy
            Sheets("DB TEMP").Select
        With Sheets("DB TEMP")
            LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
        End With
            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True


    End If

Sheets("DB TEMP").Range("A" & .Rows.Count).End(xlUp).Select
Selection.PasteSpecial

Sheets("DB TEMP").Cells(LastRow, 1).PasteSpecial

selectRow = Cellule.Row
Sheets("NameOfYourSheet").Range("A" & selectRow).Copy 

Private Sub cmdTransferer_Click()

    Dim lgLigFinC As Long
    Dim lgLigFinT As Long
    Dim lgLigFinT2 As Long
    Dim CNV As Range


   'For each cell in the column A
   For Each CNV In Sheets("Clients Test v2").Range("A2:A230")

   'If cell is none empty then select it
    If CNV <> "" Then
       CNV.Select

   'Start a boucle to copy my lines 12 times (I am pretty sure there is an easyer way)
    For i = 1 To 12

    'Last empty line in my Location to paste (column A)
    lgLigFinT = Worksheets("DB Temp V2").Range("A" & Cells.Rows.Count).End(xlUp).Row + 1

    ' Copy my data of the active cell to the first empty line of my paste location
    Worksheets("Clients Test v2").Range("A" & ActiveCell.Row).Copy Destination:=Worksheets("DB Temp V2").Range("A" & lgLigFinT)
    Next


' Copy my column data and transpose it (careful if your cell is empty it will not match the precedent copy paste
lgLigFinT2 = Worksheets("DB Temp V2").Range("F" & Cells.Rows.Count).End(xlUp).Row + 1
    Worksheets("Clients Test v2").Application.Union(Range("E" & ActiveCell.Row), Range("G" & ActiveCell.Row), Range("I" & ActiveCell.Row), Range("K" & ActiveCell.Row), Range("M" & ActiveCell.Row), Range("O" & ActiveCell.Row), Range("Q" & ActiveCell.Row), Range("S" & ActiveCell.Row), Range("U" & ActiveCell.Row), Range("W" & ActiveCell.Row), Range("Y" & ActiveCell.Row), Range("AA" & ActiveCell.Row)).Copy
    Worksheets("DB Temp V2").Range("F" & lgLigFinT2).PasteSpecial Transpose:=True

    End If
Next

  End Sub