Looping a macro to another worksheet

[El Matador]

Hey guys,

Please bear with me as I don't have that much experience with excel. Im trying to create a macro that will select certain data from one worksheet and paste it into another. I got through this fine but hit a roadblock when I tried to get it to do the same for the row.

Basically, what I need it to do is to copy certain data from sheet 1 (called Master Sheet) to sheet 2 (Called feed sheet). Each row from sheet 1 should correspond to the same row in sheet 2. I would like the loop to continue until there is no more data.

this is what my macro is looking like at the moment (ugly, I know)

Sub DataImport()
'
' DataImport Macro
' Macro recorded 5/31/2011 by Jesus Fernandez


'
Range("E4").Select
Selection.Copy
Sheets("Feed Sheet").Select
Range("B4").Select
ActiveSheet.Paste
Sheets("Master Sheet").Select
Range("A4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feed Sheet").Select
Range("A4").Select
ActiveSheet.Paste
Range("C4").Select
Sheets("Master Sheet").Select
Range("J4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feed Sheet").Select
ActiveSheet.Paste
Sheets("Master Sheet").Select
Range("L4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feed Sheet").Select
Range("D4").Select
ActiveSheet.Paste
Sheets("Master Sheet").Select
ActiveWindow.SmallScroll ToRight:=9
Range("Q4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feed Sheet").Select
Range("E4").Select
ActiveSheet.Paste
Range("F4").Select
Sheets("Master Sheet").Select
Range("S4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feed Sheet").Select
ActiveSheet.Paste
Sheets("Master Sheet").Select
Range("T4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feed Sheet").Select
Range("G4").Select
ActiveSheet.Paste
Sheets("Master Sheet").Select
Range("V4").Select
Columns("V:V").ColumnWidth = 11.86
Application.CutCopyMode = False
Selection.Copy
Sheets("Feed Sheet").Select
Range("H4").Select
ActiveSheet.Paste
Sheets("Master Sheet").Select
ActiveWindow.SmallScroll ToRight:=8
Columns("AD:AD").ColumnWidth = 18.14
Range("AD4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feed Sheet").Select
Range("I4").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=7
Sheets("Master Sheet").Select
ActiveWindow.SmallScroll ToRight:=8
Range("AK4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feed Sheet").Select
Range("J4").Select
ActiveSheet.Paste
Range("K4").Select
Sheets("Master Sheet").Select
Range("AL4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feed Sheet").Select
ActiveSheet.Paste
Sheets("Master Sheet").Select
ActiveWindow.SmallScroll ToRight:=9
Range("AT4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feed Sheet").Select
Range("L4").Select
ActiveSheet.Paste
Columns("K:K").ColumnWidth = 23.43
Columns("J:J").ColumnWidth = 29.43
Columns("K:K").ColumnWidth = 27.71
Columns("K:K").ColumnWidth = 34.29
Columns("L:L").ColumnWidth = 15.71
Sheets("Master Sheet").Select
Range("AU4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feed Sheet").Select
Range("M4").Select
ActiveSheet.Paste
Sheets("Master Sheet").Select
Range("AV4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feed Sheet").Select
Range("N4").Select
ActiveSheet.Paste
Sheets("Master Sheet").Select
Range("AS28").Select

End Sub

I apologize in advance if it's something that's been covered before, I did a search and tried some of the suggestions without much success.

Thanks!

 

[JackDanIce]

Welcome to the board

Haven't tested this yet because I'm tired and about to go to bed and there was lots of code to clean up, rather than difficult to infer what you require. Highly recommend testing this on a backup of your file first:

Sub DataImport()
'
' DataImport Macro
' Macro recorded 5/31/2011 by Jesus Fernandez
' Updated by Me

Dim i As Long
Dim MS As Worksheet, FS As Worksheet

Set MS = Sheets("Master Sheet")
Set FS = Sheets("Feed Sheet")

Application.ScreenUpdating = False

For i = 4 To MS.Range("E" & Rows.Count).End(xlUp).Row
    With MS
        .Range("E" & i).Copy
        FS.Range("B" & i).PasteSpecial Paste:=xlValues
        .Range("A" & i).Copy
        FS.Range("A" & i).PasteSpecial Paste:=xlValues
        .Range("J" & i).Copy
        FS.Range("C" & i).PasteSpecial Paste:=xlValues        
        .Range("L" & i).Copy
        FS.Range("D" & i).PasteSpecial Paste:=xlValues       
        .Range("Q" & i).Copy
        FS.Range("E" & i).PasteSpecial Paste:=xlValues      
        .Range("S" & i).Copy
        FS.Range("F" & i).PasteSpecial Paste:=xlValues       
        .Range("T" & i).Copy
        FS.Range("G" & i).PasteSpecial Paste:=xlValues        
        .Range("V" & i).Copy
        FS.Range("H" & i).PasteSpecial Paste:=xlValues        
        .Range("AD" & i).Copy
        FS.Range("I" & i).PasteSpecial Paste:=xlValues        
        .Range("AK" & i).Copy
        FS.Range("J" & i).PasteSpecial Paste:=xlValues        
        .Range("AL" & i).Copy
        FS.Range("K" & i).PasteSpecial Paste:=xlValues        
        .Range("AT" & i).Copy
        FS.Range("L" & i).PasteSpecial Paste:=xlValues       
        .Range("AU" & i).Copy
        FS.Range("M" & i).PasteSpecial Paste:=xlValues       
        .Range("AV" & i).Copy
        FS.Range("N" & i).PasteSpecial Paste:=xlValues       
        .Select       
    End With    
Next i

Range("A1").Select
Application.ScreenUpdating = True

End Sub

Probably a more elegant/simpler solution but as above, too tired to consider!

 

[El Matador]

Hey man!

Thanks so much, it worked like a charm. You sir are awesome.

Thanks again!

 

[dfenton21]

Hi There,

Welcome to MrExcel.

I agree with Jack. It can be very time consuming to clean up recorded code, so I've provided a template below that you should be able to use for your purpose with only a little modification.

I would recommend avoiding using copy and paste. A simpler solution is to set the value of one cell to the value of another, e.g.

sheets("MasterSheet").Range("A1").value = sheets("FeedSheet").Range("A1").value

That code takes the value of A1 in FeedSheet and puts it in A1 in MasterSheet. Using this as a base, you can use a loop to work through your rows.

Sub CopyDataFromMultipleCols()

    Dim iDestRow As Integer
     
    'this is the row number of the first row of your destination range
    iDestRow = 1

    'change the range to your source range
    For Each cell In Sheets("Sheet1").Range("A1:A50")
    
        'this takes the value of column A in the source sheet and puts it in col A in the destination sheet
        Sheets("Sheet2").Range("A" & iDestRow).Value = cell.Value

        'this takes the value of column C in the source sheet and puts it in col B in the destination sheet
        Sheets("Sheet2").Range("B" & iDestRow).Value = cell.Offset(0, 2).Value

        'this takes the value of column F in the source sheet and puts it in col C in the destination sheet
        Sheets("Sheet2").Range("C" & iDestRow).Value = cell.Offset(0, 5).Value

        ' this adds 1 to the destination row to move to the next row on the next loop
        iDestRow = iDestRow + 1
    
    Next cell

End Sub

The above code uses offset, e.g.

Range("A1").offset(0, 1) is B1, i.e. offset by one column
Range("A1").offset(0, 5) is F1, i.e. offset by five columns

You can copy each line of the for...next loop to do as many columns as you like, just remember to change the destination column and the source offset number.

Please let me know if you have any questions.

Damien

 

[JackDanIce]

Good spot Damien - clearly too tired to be thinking efficiently! So based on that, mine would be changed to:

Sub DataImport()
'
' DataImport Macro
' Macro recorded 5/31/2011 by Jesus Fernandez
' Updated by Me

Dim i As Long, j As Long
Dim MS As Worksheet, FS As Worksheet

Set MS = Sheets("Master Sheet")
Set FS = Sheets("Feed Sheet")

Application.ScreenUpdating = False

For i = 4 To MS.Range("E" & Rows.Count).End(xlUp).Row
    With MS
        For j = 1 To 14
            FS.Cells(i, j).Value = .Range("A" & i).Value
            FS.Cells(i, j).Value = .Range("E" & i).Value
            FS.Cells(i, j).Value = .Range("J" & i).Value
            FS.Cells(i, j).Value = .Range("L" & i).Value
            FS.Cells(i, j).Value = .Range("Q" & i).Value
            FS.Cells(i, j).Value = .Range("S" & i).Value
            FS.Cells(i, j).Value = .Range("T" & i).Value
            FS.Cells(i, j).Value = .Range("V" & i).Value
            FS.Cells(i, j).Value = .Range("AD" & i).Value
            FS.Cells(i, j).Value = .Range("AK" & i).Value
            FS.Cells(i, j).Value = .Range("AL" & i).Value
            FS.Cells(i, j).Value = .Range("AT" & i).Value
            FS.Cells(i, j).Value = .Range("AU" & i).Value
            FS.Cells(i, j).Value = .Range("AV" & i).Value
        Next j
    End With
Next i
With Application
    .Goto MS.Range("A1")
    .ScreenUpdating = True
End With

End Sub

However, if you can understand Damien's template, it should help you in future adjust your macro for new sheets where you are doing a similar exercise - i.e. in the above, replace the =.Range part with =.Cells(i, j + some adjustment) Since it looks like you're just moving cells of consecutive columns in your feed sheet into non-consecutive columns in your master sheet

 

[El Matador]

You guys are awesome, thanks again so much.

 

[JackDanIce]

You're welcome