Всем добрый вечер! Прошу помочь с реализацией. Есть макрос консолидации и обновления данных, подсмотрела на просторах. Он работает, но только в отношении 2 вкладок: "import" и "backup" , как изменить макрос, чтобы консолидация и обновление происходило со всех вкладок в книге на вкладку "backup"? Уже всю голову сломала, спать спокойно не могу. Несколько вариантов перепробовала, не хочет
[vba]
Код
Sub Copy_New_Data() '''''''' TeachExcel.com '''''''' 'Copy all new rows from one worksheet to another.
Dim importSheet As Worksheet, destinationSheet As Worksheet Dim importLastRow, importColumnCheck, destinationColumnCheck, _ importStartRow, destinationStartRow, curRow, destinationLastRow As Integer Dim dataToCheck As Variant Dim rng, rDel As Range
' ------------------------------------------------------------------- ' ' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| ' ' Change this section to work for your workbook. ' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| ' ' ------------------------------------------------------------------- ' 'Set the worksheets Set importSheet = Sheets("import") Set destinationSheet = Sheets("backup") 'worksheet to paste new data
'Import data column to check importColumnCheck = 2 'Destination data column to check destinationColumnCheck = 2
'Get last row from import worksheet importLastRow = importSheet.Cells(Rows.Count, importColumnCheck).End(xlUp).Row
'Loop through range For curRow = importStartRow To importLastRow
'Get data to check dataToCheck = importSheet.Cells(curRow, importColumnCheck).Value
'Get last row from destination sheet destinationLastRow = destinationSheet.Cells(Rows.Count, importColumnCheck).End(xlUp).Row
'Check for duplicate With destinationSheet.Range(destinationSheet.Cells(destinationStartRow, destinationColumnCheck), destinationSheet.Cells(destinationLastRow, destinationColumnCheck)) Set rng = .Find(What:=dataToCheck, _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False)
If Not rng Is Nothing Then 'Record already exists
'mark rows for deletion If Not rDel Is Nothing Then Set rDel = Union(Range("A" & curRow), rDel) Else Set rDel = Range("A" & curRow) End If
Else 'New record, so copy it over importSheet.Range("A" & curRow).EntireRow.Copy destinationSheet.Range("A" & destinationLastRow + 1)
'mark rows for deletion If Not rDel Is Nothing Then Set rDel = Union(Range("A" & curRow), rDel) Else Set rDel = Range("A" & curRow) End If
End If
End With
Next curRow
'Delete rows that need to be deleted 'Un-comment the next line of code if you want to delete copied rows. 'rDel.EntireRow.Delete
End Sub
[/vba]
Всем добрый вечер! Прошу помочь с реализацией. Есть макрос консолидации и обновления данных, подсмотрела на просторах. Он работает, но только в отношении 2 вкладок: "import" и "backup" , как изменить макрос, чтобы консолидация и обновление происходило со всех вкладок в книге на вкладку "backup"? Уже всю голову сломала, спать спокойно не могу. Несколько вариантов перепробовала, не хочет
[vba]
Код
Sub Copy_New_Data() '''''''' TeachExcel.com '''''''' 'Copy all new rows from one worksheet to another.
Dim importSheet As Worksheet, destinationSheet As Worksheet Dim importLastRow, importColumnCheck, destinationColumnCheck, _ importStartRow, destinationStartRow, curRow, destinationLastRow As Integer Dim dataToCheck As Variant Dim rng, rDel As Range
' ------------------------------------------------------------------- ' ' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| ' ' Change this section to work for your workbook. ' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| ' ' ------------------------------------------------------------------- ' 'Set the worksheets Set importSheet = Sheets("import") Set destinationSheet = Sheets("backup") 'worksheet to paste new data
'Import data column to check importColumnCheck = 2 'Destination data column to check destinationColumnCheck = 2