Copying data using a loop

[paexcel]

I have data in one tab ("Country") organized by columns:

Col A Col B Col C Col D Col E Col F
Italy Euro Prod1 Cost Date ROW
Italy Euro Prod2 Cost Date ROW
Spain Euro Prod1 Cost Date ROW
Italy Euro Prod3 Cost Date ROW

I want to loop through the range, which will change with each download from outside source. Each time it sees "Italy", which will be typed into another reference cell on tab ("Summary"), it will copy the data from only columns C thru E, find the next empty cell on tab ("Summary") and paste the data. It will then go back and search until it comes to end of the range. Thanks.

 

[dave3009]

Hi paexcel, welcome to the board

Sub Macro1()
Dim lst As Long
lst = Sheets("Countries").Range("A" & Rows.Count).End(xlUp).Row
    
    With Sheets("Countries")
        .Range("$A$1:$F$" & lst).AutoFilter Field:=1, Criteria1:="Italy"
        .Range("C1:F" & lst).SpecialCells(xlCellTypeVisible).Copy Sheets("Summary").Range("A1")
        .Range("$A$1:$F$" & lst).AutoFilter
    End With
End Sub

 

[lenze]

Assumptions
1) "$A$1" is where the country is on Sheet "Summary"
2) You want the data from C:E copied to C:E on sheet "Summary"

Sub MoveMe()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("Country")
Set ws2 = Worksheets("Summary")
Dim cl As Range
Dim LR1 As Long
Dim LR2 As Long
LR1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row
For Each cl In ws1.Range("$A$2:$A" & LR1)
   If cl = ws2.Range("$A1") Then
      LR2 = ws2.Cells(Rows.Count, "C").End(xlUp).Row
      ws1.Cells(cl.Row, "C").Resize(1, 3).Copy ws2.Cells(LR2 + 1, "C")
    End If
Next cl
End Sub

Have you thought of using an Input Box instead of a cell on Sheet "Summary"?

Sub MoveMe()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("Country")
Set ws2 = Worksheets("Summary")
Dim cl As Range
Dim LR1 As Long
Dim LR2 As Long
LR1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row
rspn = InPutBox ("Enter the country of Interest")
For Each cl In ws1.Range("$A$2:$A" & LR1)
   If cl = rspn Then
      LR2 = ws2.Cells(Rows.Count, "C").End(xlUp).Row
      ws1.Cells(cl.Row, "C").Resize(1, 3).Copy ws2.Cells(LR2 + 1, "C")
    End If
Next cl
End Sub

lenze

 

[paexcel]

This works great. Reason I am linking to another cell instead an Input Box is that cell is entered by user for other reasons. One last question, instead of copying to row "C" on the SUmmary tab, how can I get it to paste to cell A5 on the Summary tab?

 

[lenze]

To alway paste to A5

ws1.Cells(cl.Row, "C").Resize(1, 3).Copy ws2.Range("$A$5")

You can remove all lines of code that refer to LR2
lenze

 

[paexcel]

That worked great, thanks.