Calcul de gamme faisant référence à une autre colonne

Question

A.Range(A2 & Lrow).Copy B.Cells(Rows.Count, "A").End(xlUp).Offset(1, 1) 
A.Cells(1,1).Copy B.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) 

Voici le code qui copie le premier titre et sa colonne correspondante

Sheet A         Code Output 

    Male Female      Male  Mike   
    Mike Rose       Female John 
    John Kat         Bob 
    Bob  Lisa         Rose 
               Kat 
               Lisa 
          Expected output 

       Male Mike     Male Mike 
         John     Male John 
         Bob    OR  Male Bob 
       Female Rose     Female Rose 
         Kat      Female Kat 
         Lisa     Female Lisa 

Permettez-moi d'expliquer: Quand j'utilise le code normal que je l'utilise chaque fois pour copier coller, Je reçois mâle et femelle dans lignes consécutives qui est faux comme Femme devrait commencer à partir Rose. Je vois que le seul problème peut être que la plage que j'utilise pour décaler la première colonne est trouvée en montant, donc le compilateur ira jusqu'à la 2ème rangée en premier tandis que je veux qu'il aille jusqu'à la dernière valeur de la colonne B. une de cette sortie est-elle possible?

B.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) 

C'est ce que j'ai besoin de changer Je pense Mais besoin d'aide. Merci.

Answer 1

Vous devriez être en mesure de modifier ce pour le faire fonctionner:

male_count = Application.WorksheetFunction.CountA(Worksheets("Sheet A").Range("A1:A100")) 
female_count = Application.WorksheetFunction.CountA(Worksheets("Sheet A").Range("B1:B100")) 

Worksheets("Sheet A").Range("A1").Copy 
Worksheets("code output").Range("A1").PasteSpecial Paste:=xlPasteValues 

Worksheets("Sheet A").Range("A2:A" & male_count).Copy 
Worksheets("code output").Range("B1").PasteSpecial Paste:=xlPasteValues 

Worksheets("Sheet A").Range("B1").Copy 
Worksheets("code output").Range("A" & male_count).PasteSpecial Paste:=xlPasteValues 

Worksheets("Sheet A").Range("B2:B" & female_count).Copy 
Worksheets("code output").Range("B" & male_count).PasteSpecial Paste:=xlPasteValues 

Answer 2

Sub Test() 
    Dim wb As Workbook 
    Set wb = ThisWorkbook 
    Dim ws As Worksheet 
    Set ws1 = wb.Sheets("Sheet1") 'Rename Sheet1 to your sheet where source data is 
    Set ws2 = wb.Sheets("Sheet2") 'Rename Sheet2 to your sheet where you want output 
    ws1.Activate 
    LastRow1 = Range("A" & Rows.Count).End(xlUp).Row 'Change Column Letter to where you have Male names 
    LastRow2 = Range("B" & Rows.Count).End(xlUp).Row 'Change Column Letter to where you have Femal names 
    Set MaleRng = ws1.Range(Cells(2, 1), Cells(LastRow1, 1)) 
    Set FemaleRng = ws1.Range(Cells(2, 2), Cells(LastRow2, 2)) 
    i = 1 
    For Each Male In MaleRng 
    ws2.Cells(i, 1) = "Male" 
    ws2.Cells(i, 2) = Male.Value 
    i = i + 1 
    Next 
    ws2.Activate 
    i = ws2.Range("A" & Rows.Count).End(xlUp).Row 
    j = i + 1 
    For Each Female In FemaleRng 
    ws2.Cells(j, 1) = "Female" 
    ws2.Cells(j, 2) = Female.Value 
    j = j + 1 
    Next 

    End Sub