Estou tentando copiar dados de 7 planilhas diferentes (na mesma pasta de trabalho) em uma planilha chamada Combine [duplicar]
Dec 23 2020
Estou tentando copiar dados de 7 planilhas diferentes (na mesma pasta de trabalho) em uma planilha chamada Combine. Também preciso de uma planilha chamada 'Resumo' para não ser copiada. e depois que as 7 planilhas forem copiadas, elas precisam ser excluídas.
Isso é o que eu tenho até agora, mas ele apenas copia a planilha ACT
Sub Combine()
Dim s As Worksheet, wb As Workbook, wsDest As Worksheet, rngCopy As Range
Set wb = ActiveWorkbook ' always specify a workbook
Application.DisplayAlerts = False
On Error Resume Next
wb.Sheets("ACT").Delete 'These sheets don't need to be kept or consolidated
wb.Sheets("VIC").Delete
wb.Sheets("NSW").Delete
wb.Sheets("QLD").Delete
wb.Sheets("NT").Delete
wb.Sheets("SA").Delete
wb.Sheets("WA").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'get a direct reference to the newly-added sheet
Set wsDest = wb.Worksheets.Add(before:=wb.Worksheets(1))
wsDest.Name = "Combine"
wb.Sheets(2).Range("A1").EntireRow.Copy Destination:=wsDest.Range("A1")
For Each s In ActiveWorkbook.Sheets
If s.Name <> "Summary" Then ' remove hard-coded name
Set rngCopy = s.Range("A1").CurrentRegion
'check how many rows before copying
If rngCopy.Rows.Count > 1 Then
'no need for select/activate
rngCopy.Offset(1, 0).Resize(rngCopy.Rows.Count - 1).Copy _
wsDest.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
End If
Next s
End Sub
Respostas
Tomasz Dec 23 2020 at 15:56
tente o código abaixo, a edição está marcada.
Sub Combine()
Dim rngCopy As Range '<< edited visual
Dim wb As Workbook '<< edited visual
Dim s As Worksheet, wsDest As Worksheet '<< edited visual
Application.DisplayAlerts = False '<< edited
Application.EnableEvents = False '<< edited
Application.ScreenUpdating = False '<< edited
Set wb = ThisWorkbook '<< edited
'get a direct reference to the newly-added sheet
Set wsDest = wb.Worksheets.Add(before:=wb.Worksheets(1)) '<< edited visual
wsDest.Name = "Combine" '<< edited visual
wb.Worksheets(2).Rows(1).EntireRow.Copy Destination:=wsDest.Range("A1") '<< edited
For Each s In wb.Worksheets '<< edited
If s.Name = "ACT" Or s.Name = "VIC" Or s.Name = "NSW" Or _
s.Name = "QLD" Or s.Name = "NT" Or s.Name = "SA" Or s.Name = "WA" Then '<< edited
s.Delete '<< edited
ElseIf s.Name <> "Summary" Then '<< remove hard-coded name
Set rngCopy = s.Range("A1").CurrentRegion
'check how many rows before copying
If rngCopy.Rows.Count > 1 Then
'no need for select/activate
rngCopy.Offset(1, 0).Resize(rngCopy.Rows.Count - 1).Copy _
wsDest.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
End If
Next s
Application.DisplayAlerts = True '<< edited
Application.EnableEvents = True '<< edited
Application.ScreenUpdating = True '<< edited
End Sub
O que significa um erro “Não é possível encontrar o símbolo” ou “Não é possível resolver o símbolo”?
Christopher Nolan uma vez se arrependeu de ter lido o 'roteiro de Pulp Fiction' de Quentin Tarantino