Question

我想在myworkbook中放置VBA代码，用于动态复制从sheet1和sheet2到原始工作表的范围A1：C“X”（X数字单元格变量）：

原始工作表中的结果：

这是我的代码：

Sheets("sheet1").Activate

adre1 = Cells.Find(What:="Personne - Type1", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Address



taille = (65537 - Range(adre1).Row) - Range(Cells(65536, Range(adre1).Column), Cells(65536, Range(adre1).Column).End(xlDown)).Count


If taille <> 0 Then

    Sheets("sheet1").Activate
    Sheets(sheet1).Range(Range(adre1).Offset(1, 0), Range(adre1).Offset(taille, 3)).Select

    Selection.Copy

   Sheets("original").Activate

    taille2 = (65537 - Range(adre1).Row) - Range(Cells(65536, Range(adre1).Column), Cells(65536, Range(adre1).Column).End(xlUp)).Count


    Sheets(original).Range(adre1).Offset(1 + taille2, 0).Select

    ActiveSheet.Paste

但我有这个结果：

Answer 1

或许这个会更好吗？

Dim gvWsh1 As Worksheet
Dim gvWsh2 As Worksheet
Dim gvWsh3 As Worksheet
Dim gvDblIndexActuel As Double

Public Sub MainEntry()
    Dim dernligne As Double
    Dim d As Double
    Dim strUserType As String
    Dim rowsToAdd As Range

    ' Set the worksheets
    Set gvWsh1 = ThisWorkbook.Worksheets("Feuil1")
    Set gvWsh2 = ThisWorkbook.Worksheets("Feuil2")
    Set gvWsh3 = ThisWorkbook.Worksheets("Feuil3")

    ' Clear the First Woksheet
    gvWsh1.Cells.ClearContents

    ' copy the content of first Worksheet
    gvWsh2.Range("A1").CurrentRegion.Copy gvWsh1.Range("A1")
    ' Get the last pasted line + 1
    dernligne = gvWsh1.Range("A1").CurrentRegion.Rows.Count + 1
    ' For each lines from the last to the second
    Do While dernligne > 2
        ' GetThe searched Term
        strUserType = gvWsh1.Range("A" & dernligne).End(xlUp)
        ' Get the range of third sheet to paste
        Set rowsToAdd = GetWsh3RowsForType(strUserType)
        rowsToAdd.Copy
        ' past it to the lastline
        gvWsh1.Range("A" & dernligne).Insert , rowsToAdd
        ' Set lastLine to the type for the next loop
        dernligne = gvWsh1.Range("A" & dernligne).End(xlUp).Row
    ' next
    Loop

End Sub

Private Function GetWsh3RowsForType(pUserType As String) As Range
    ' TODO Coder
    Dim dernligne As Double
    Dim lastBlockLine As Double
    Dim firstBlockLine As Double
    Dim strUserType As String

    ' Get the last line
    dernligne = gvWsh3.Range("A1").CurrentRegion.Rows.Count + 1
    lastBlockLine = dernligne - 1
    ' For each value in Col A
    Do While dernligne > 2
        strUserType = gvWsh3.Range("A" & dernligne).End(xlUp)
        firstBlockLine = gvWsh3.Range("A" & dernligne).End(xlUp).Row + 1
        ' If value = param
        If strUserType = pUserType Then
            ' Get the first and last line of the block
            ' Set return to Rows of those lines
            Set GetWsh3RowsForType = gvWsh3.Rows(firstBlockLine & ":" & lastBlockLine)
            Exit Function
        ' sinon
        Else
            ' DernLigne = Next value row
            dernligne = gvWsh3.Range("A" & dernligne).End(xlUp).Row
            ' Dernier block sera une ligne avant
            lastBlockLine = dernligne - 1
        ' endif
        End If
    ' Next
    Loop

End Function

从多个工作表到一个

1 个答案: