assistance required copy macro not giving expected results to new sheet

[JEAN1972]

Hi All

Trying to copy specific column to another sheet but some columns need not to be copied but still being copied by the macro.

Should start at A1 of the new sheet

See attached of expected results

Can anyone help

Sub M1()

    Dim ws1     As Worksheet
    Dim ws2     As Worksheet
    
    Dim arr()   As Variant
    Dim var     As Variant
    Dim x       As Long
    
    Set ws1 = Sheets("corps")
    Set ws2 = Sheets("csv")
    
    With ws1
        For Each var In Array("A", "B", "C", "D", "H", "I", "K", "L", " M", "Q", "R", "S", "T", "W")
            x = .Range(CStr(var) & .Rows.Count).End(xlUp).Row
            arr = .Range(CStr(var) & 1).Resize(x).Value
            
            ws2.Range(CStr(var) & 1).Resize(UBound(arr, 1)).Value = arr
            Erase arr
        Next var
    End With
    
    Set ws1 = Nothing
    Set ws2 = Nothing

End Sub

[mike7952]

This should work

Sub M1()

    Dim ws1     As Worksheet
    Dim ws2     As Worksheet
    
    Dim arr()   As Variant
    Dim var     As Variant
    Dim x       As Long
    Dim icol    As Long
    Set ws1 = Sheets("corps")
    Set ws2 = Sheets("csv")
    
    With ws1
        x = .Range("a" & .Rows.Count).End(xlUp).Row: icol = 1
        For Each var In Array("A", "B", "C", "D", "H", "I", "K", "L", " M", "Q", "R", "S", "T", "W")
            
            arr = .Range(CStr(var) & 1).Resize(x).Value
            
            ws2.Cells(1, icol).Resize(UBound(arr, 1)).Value = arr
            Erase arr: icol = icol + 1
        Next var
    End With
    
    Set ws1 = Nothing
    Set ws2 = Nothing

End Sub

[JEAN1972]

This should work

Sub M1()

    Dim ws1     As Worksheet
    Dim ws2     As Worksheet
    
    Dim arr()   As Variant
    Dim var     As Variant
    Dim x       As Long
    Dim icol    As Long
    Set ws1 = Sheets("corps")
    Set ws2 = Sheets("csv")
    
    With ws1
        x = .Range("a" & .Rows.Count).End(xlUp).Row: icol = 1
        For Each var In Array("A", "B", "C", "D", "H", "I", "K", "L", " M", "Q", "R", "S", "T", "W")
            
            arr = .Range(CStr(var) & 5).Resize(x).Value
            
            ws2.Cells(1, icol).Resize(UBound(arr, 1)).Value = arr
            Erase arr: icol = icol + 1
        Next var
    End With
    
    Set ws1 = Nothing
    Set ws2 = Nothing

End Sub

Thanks mike working a little adjustment in bold

[AB33]

You left a blank column in G.

Sub M1()

    Dim ws1     As Worksheet
    Dim ws2     As Worksheet
    Dim NextCol  As Long
    Dim arr()   As Variant
    Dim var     As Variant
    Dim x       As Long
    
    Set ws1 = Sheets("corps")
    Set ws2 = Sheets("csv")
    NextCol = 1
    With ws1
        For Each var In Array("A", "B", "C", "D", "H", "I", "K", "L", " M", "Q", "R", "S", "T", "W")
            x = .Range(CStr(var) & .Rows.Count).End(xlUp).Row
            arr = .Range(CStr(var) & 5).Resize(x).Value
            
            ws2.Cells(1, NextCol).Resize(UBound(arr, 1)).Value = arr
            NextCol = NextCol + 1
            Erase arr
        Next var
    End With
    
    Set ws1 = Nothing
    Set ws2 = Nothing

End Sub

[JEAN1972]

Thank you for assistance working now

[mike7952]

I don't understand? What in Bold?

[JEAN1972]

I don't understand? What in Bold?

arr = .Range(CStr(var) & 5).Resize(x).Value

I was meaning that it was 1 instead of 5 as it copies the first 4 rows which was not required as per expected csv example.

[daboho]

Sub M1()
    Dim ws1     As Worksheet
    Dim ws2     As Worksheet
    Dim COL, Ncol As String: COL = "ABCDHIKLMQRSTW"
    Dim I&
    Set ws1 = Sheets("corps")
    Set ws2 = Sheets("csv")
    With ws1
       For I = 1 To Len(COL)
           Ncol = Mid(COL, I, 1)
              Set Rng = Intersect(.UsedRange.Offset(5, 0), .Columns(Ncol).SpecialCells(xlCellTypeConstants))
              Rng.Copy ws2.Range(Ncol & 5)
         Next
    End With
End Sub

[JEAN1972]

Sub M1()
    Dim ws1     As Worksheet
    Dim ws2     As Worksheet
    Dim COL, Ncol As String: COL = "ABCDHIKLMQRSTW"
    Dim I&
    Set ws1 = Sheets("corps")
    Set ws2 = Sheets("csv")
    With ws1
       For I = 1 To Len(COL)
           Ncol = Mid(COL, I, 1)
              Set Rng = Intersect(.UsedRange.Offset(5, 0), .Columns(Ncol).SpecialCells(xlCellTypeConstants))
              Rng.Copy ws2.Range(Ncol & 5)
         Next
    End With
End Sub

Hi Daboho

I tested your code it copies the blanks column which I do not need

I have also modified the code so that it starts the headers , however I have no idea why it copies the blank column (I d'ont need these columns
Check the csv expected results , however I leave column G blank, to ignore G as I do not need this columns

Sub dabohoM1()
    Dim ws1     As Worksheet
    Dim ws2     As Worksheet
    Dim COL, Ncol As String: COL = "ABCDHIKLMQRSTW"
    Dim I&
    Set ws1 = Sheets("corps")
    Set ws2 = Sheets("csv")
    With ws1
       For I = 1 To Len(COL)
           Ncol = Mid(COL, I, 1)
              Set Rng = Intersect(.UsedRange.Offset(4, 0), .Columns(Ncol).SpecialCells(xlCellTypeConstants))
              Rng.Copy ws2.Range(Ncol & 1)
         Next
    End With
End Sub

[mike7952]

sorry my bad

[JEAN1972]

sorry my bad

No problem, we are here to help each other

The climate is very hot where I am, my head gets dumbed .

Thanks again for your help

Regards

Jean