简体   繁体   中英

How to copy data from one sheet to another?

I have a form in Excel filled with country information in like 100 different lines.

I'm trying to get all that info into another sheet called "BANCO DE DADOS".
Each country will have a line and the columns will have the data like name, population and other info.

If the country does not exist it should be added.
If the country exists it should overwrite the line.

I found some codes and tried to put it together.
Right now if the country does not exist, it adds the info.

If the country exists, it should but does not overwrite data.

Dim LastRow As Long
Dim ws As Worksheet
Dim Rng1 As Range

'LETS SET THE COUNTRY NAME
letsfind = Range("AA16").Value

'LETS CHECK IF THE COUNTRY NAME EXISTS IN RANGE F:F
With Worksheets("BANCO DE DADOS").Range("F:F")
    Set Rng1 = .Find(What:=letsfind, _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
                    
'IF THE COUNTRY EXISTS THEN LETS OVERWRITE THE WHOLE LINE
    If Not Rng1 Is Nothing Then
        LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
        'MsgBox "01- TOTAL ROW NUMBER: " & LastRow
        'MsgBox "02- WE ARE LOOKING FOR: " & letsfind
        'MsgBox "03- COUNTRY ALREADY EXISTS, SO LETS OVERWRITE THE WHOLE LINE."
        
        Worksheets("BANCO DE DADOS").Range("F" & LastRow).Find(Rng1).Offset(0, -4).Value = Range("AA16").Value
        Worksheets("BANCO DE DADOS").Range("F" & LastRow).Find(Rng1).Offset(0, -3).Value = Range("AA9").Value
        Worksheets("BANCO DE DADOS").Range("F" & LastRow).Find(Rng1).Offset(0, -2).Value = Range("AA10").Value
        Worksheets("BANCO DE DADOS").Range("F" & LastRow).Find(Rng1).Offset(0, -1).Value = Range("AA11").Value
        Worksheets("BANCO DE DADOS").Range("F" & LastRow).Find(Rng1).Offset(0, 0).Value = Range("AA16").Value
    Else
        'MsgBox "04- COUNTRY DOESN'T EXISTS, SO LETS ADD THE WHOLE LINE."
        'COPY DATA FROM THIS SHEET TO BANCO DE DADOS.
        next_row = Worksheets("BANCO DE DADOS").Range("F" & Rows.Count).End(xlUp).Offset(1).Row
        'MsgBox "06- COUNTRY WILL BE ADDED TO LINE: " & next_row
        
        Worksheets("BANCO DE DADOS").Cells(next_row, 2).Value = Range("AA16").Value
        Worksheets("BANCO DE DADOS").Cells(next_row, 3).Value = Range("AA9").Value
        Worksheets("BANCO DE DADOS").Cells(next_row, 4).Value = Range("AA10").Value
        Worksheets("BANCO DE DADOS").Cells(next_row, 5).Value = Range("AA11").Value
        Worksheets("BANCO DE DADOS").Cells(next_row, 6).Value = Range("AA16").Value
    End If
End With

I am not sure you want to modify "BANCO DE DADOS" incrementally or if you want to make the list once.

If you want to create the list at once, this is a very good problem for the scripting dictionary. In the code below, I have data from columns F to I of Sheet1 with the name of the countries in column 6 (F). I use and array to store the countries information and a scripting dictionary to store the countries name and the index in the array. Once this is done, I copy the array to the destination (Sheet2). I have to cycle through the indexes of the array instead of copying it into a range because the array is inverted.

You need to add the Microsoft Scripting Runtime (scrrun.dll) as a reference for it to work.

Option Explicit

Public Sub CopyData()

Dim i As Long
Dim j As Integer
Dim xlWB As Workbook
Dim xlWS_IN As Worksheet
Dim xlWS_Out As Worksheet
Dim TheIndex As Integer
Dim CountryList As New Scripting.Dictionary 'Dictionary to contain the names and the line index in the array
Dim CountryInfo() As String 'Array to contain the countries information
Dim topRow As Long
Dim lastRow As Long
Dim InfoCount As Integer

Set xlWB = ThisWorkbook
Set xlWS_IN = xlWB.Worksheets("Sheet1")
Set xlWS_Out = xlWB.Worksheets("Sheet2")

InfoCount = 4   'The number of information fields plus country name
TheIndex = 0
ReDim CountryInfo(InfoCount, TheIndex)
'for country names + 3 parameters and one line. The number of lines must be the last index to use Redim later

topRow = xlWS_IN.UsedRange.Row
lastRow = xlWS_IN.UsedRange.Rows.Count + xlWS_IN.UsedRange.Row
For i = topRow To lastRow - 1
    If Not CountryList.Exists(xlWS_IN.Cells(i, 6).Value) Then
        CountryList.Add Key:=xlWS_IN.Cells(i, 6).Value, Item:=TheIndex
        TheIndex = TheIndex + 1
        ReDim Preserve CountryInfo(InfoCount, TheIndex)
        CountryInfo(1, TheIndex) = xlWS_IN.Cells(i, 6).Value
        CountryInfo(2, TheIndex) = xlWS_IN.Cells(i, 7).Value
        CountryInfo(3, TheIndex) = xlWS_IN.Cells(i, 8).Value
        CountryInfo(4, TheIndex) = xlWS_IN.Cells(i, 9).Value
    Else
        'No need to re-write the country name as they are already in the array
        CountryInfo(2, CountryList(xlWS_IN.Cells(i, 6).Value)) = xlWS_IN.Cells(i, 7).Value
        CountryInfo(3, CountryList(xlWS_IN.Cells(i, 6).Value)) = xlWS_IN.Cells(i, 8).Value
        CountryInfo(4, CountryList(xlWS_IN.Cells(i, 6).Value)) = xlWS_IN.Cells(i, 9).Value
    End If
Next i

'The array indexes 0 are skipped above so we start with 1
For i = 1 To InfoCount
    For j = 1 To UBound(CountryInfo, 2) - 1
        xlWS_Out.Cells(j, i).Value = CountryInfo(i, j)
    Next j
Next i
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM