Copy Specific Cells from one sheet to the bottom of another .

[mortu90]

Hi all,

I am very new in working with VBA, so please have patience with me. I am working at a project which I need to copy specific cells from one sheet (the master sheet) into another sheet (upload sheet).

The cells I need to copy from the "master sheet" need to be copied to the "upload sheet" as following:

Master -> Upload
L1 -> B2
L2 -> G2
L3 -> F2
L4 -> A2

L5:L ->H2:H
I5:I -> C2:C

Columns D & E will be filled with other data such as (today date, cancellation date)
All the columns will be auto filled based on H and C amount of columns (which have all the time the same amount of rows).

I want to repeat this pattern if possible with other columns M,N & O but to be added on the bottom of those describe above.
The only difference is that for example the columns M, N & O should be copied M5:M->I2:I; N5:N->J2:J; O5:O->K2:K; the rest should be as described above, but when copied to "upload file" should be on the bottom of the previous columns.


I don't know if this is too complex or I provided enough information, since I am really new to this.

Thanks a ton !
Justin

 

[JackDanIce]

Welcome to the board. Untested, however, place the following code into a module and then run the macro "Justin_Mortu_v1", lots of instructions online on how to run a macro if you don't know:

Sub Justin_Mortu_v1()

    Dim wsMaster    As Worksheet
    Dim wsUpload    As Worksheet
    
    Dim x           As Long
    Dim var         As Variant
    
    Const delim     As String = "/"
    
    Set wsMaster = Sheets("Master")
    Set wsUpload = Sheets("Upload")
    
    Application.ScreenUpdating = False
    
    With wsUpload
        x = 1
        For Each var In Array("B2", "G2", "F2", "A2")
            .Range(var).value = wsMaster.Range("L" & x).value
            x = x + 1
        Next var
        
        For Each var In Array("L5/H2", "I5/C2", "M5/I2", "N5/J2", "O5/K2")
            CopyCol wsMaster.Range(Split(var, delim)(0)), wsUpload.Range(Split(var, delim)(1))
        Next var
        
    End With
    
    Application.ScreenUpdating = True
    
    Set wsMaster = Nothing
    Set wsUpload = Nothing
    
End Sub
Private Sub CopyCol(ByRef srcRng As Range, ByRef destRng As Range)

    Dim arr()   As Variant
    Dim x       As Long
    
    With srcRng.Parent
        x = Application.Max(srcRng.row + 1, .Cells(.rows.count, srcRng.Column).End(xlUp).row)
        arr = srcRng.Resize(x - srcRng.row + 1).value
    End With
    
    destRng.Resize(UBound(arr, 1)).value = arr
    
    Erase arr
        
End Sub

 

[mortu90]

Thanks a lot for your support and fast response JackDanIce ! The macro works great ! However can I somehow repeat the sequence to be placed at the bottom of the first one for the next column. For example after I auto-fill all the columns involved from A to K, I need to do the same sequence for column M keeping everything the same. For example after auto filling, my macro stops at row 417, when I run again the macro for the column M, the copied cells should be placed at the end of former ones.

Master -> Upload
M1 -> B418
M2 -> G418
M3 -> F418
M4 -> A418

M5:M ->H418:H
I5:I -> C418:C

If this works, I think I can manage to build the macro for the rest of the file.

I hope I made myself somehow understood.

Thanks a lot again for your time and support !

Welcome to the board. Untested, however, place the following code into a module and then run the macro "Justin_Mortu_v1", lots of instructions online on how to run a macro if you don't know:

Sub Justin_Mortu_v1()

    Dim wsMaster    As Worksheet
    Dim wsUpload    As Worksheet
    
    Dim x           As Long
    Dim var         As Variant
    
    Const delim     As String = "/"
    
    Set wsMaster = Sheets("Master")
    Set wsUpload = Sheets("Upload")
    
    Application.ScreenUpdating = False
    
    With wsUpload
        x = 1
        For Each var In Array("B2", "G2", "F2", "A2")
            .Range(var).value = wsMaster.Range("L" & x).value
            x = x + 1
        Next var
        
        For Each var In Array("L5/H2", "I5/C2", "M5/I2", "N5/J2", "O5/K2")
            CopyCol wsMaster.Range(Split(var, delim)(0)), wsUpload.Range(Split(var, delim)(1))
        Next var
        
    End With
    
    Application.ScreenUpdating = True
    
    Set wsMaster = Nothing
    Set wsUpload = Nothing
    
End Sub
Private Sub CopyCol(ByRef srcRng As Range, ByRef destRng As Range)

    Dim arr()   As Variant
    Dim x       As Long
    
    With srcRng.Parent
        x = Application.Max(srcRng.row + 1, .Cells(.rows.count, srcRng.Column).End(xlUp).row)
        arr = srcRng.Resize(x - srcRng.row + 1).value
    End With
    
    destRng.Resize(UBound(arr, 1)).value = arr
    
    Erase arr
        
End Sub

 

[JackDanIce]

Glad it's working so far. Really busy at work right now, will try to look at this, this afternoon. However, this loop, you could try to duplicate for your M1:M4 Master values:

x = 1
For Each var In Array("B2", "G2", "F2", "A2")
    .Range(var).value = wsMaster.Range("L" & x).value
    x = x + 1
Next var

for M5
This loop, uses an additional procedure (CopyCol), which you may be able to adapt for M5:M and I5:I :

For Each var In Array("L5/H2", "I5/C2", "M5/I2", "N5/J2", "O5/K2")
    CopyCol wsMaster.Range(Split(var, delim)(0)), wsUpload.Range(Split(var, delim)(1))
Next var

Or anyone else reading this thread may be able to suggest.

Reply if you get it to work or not. If you don't, I'll try posting the updated code later.

 

[JackDanIce]

Updated:

Sub Justin_Mortu_v2()

    Dim wsMaster    As Worksheet
    Dim wsUpload    As Worksheet
    
    Dim x           As Long
    Dim var         As Variant
    
    Const delim     As String = "/"
    
    Set wsMaster = Sheets("Master")
    Set wsUpload = Sheets("Upload")
    
    Application.ScreenUpdating = False
    
    With wsUpload
        x = 1
        For Each var In Array("B2/B418", "G2/G418", "F2/F418", "A2/A418")
            .Range(Split(var, delim)(0)).value = wsMaster.Range("L" & x).value
            .Range(Split(var, delim)(1)).value = wsMaster.Range("M" & x).value
            x = x + 1
        Next var
        
        For Each var In Array("L5/H2", "I5/C2", "M5/I2", "N5/J2", "O5/K2", "M5/H418", "I5/C418")
            CopyCol wsMaster.Range(Split(var, delim)(0)), wsUpload.Range(Split(var, delim)(1))
        Next var
        
    End With
    
    Application.ScreenUpdating = True
    
    Set wsMaster = Nothing
    Set wsUpload = Nothing
    
End Sub

Private Sub CopyCol(ByRef srcRng As Range, ByRef destRng As Range)

    Dim arr()   As Variant
    Dim x       As Long
    
    With srcRng.Parent
        x = Application.Max(srcRng.row + 1, .Cells(.rows.count, srcRng.Column).End(xlUp).row)
        arr = srcRng.Resize(x - srcRng.row + 1).value
    End With
    
    destRng.Resize(UBound(arr, 1)).value = arr
    
    Erase arr
        
End Sub