Boa tarde pessoal,
Gostaria de lhes perguntar se é possível realizar alguma macro que execute a função abaixo:
Dentro de um mesmo folder terei algumas planilhas (digamos umas 5), todas no mesmo padrão de informação. Trata-se de um banco de dados com informações sobre ordens de serviço efetuadas por pessoas diferentes. Então, a coluna A de todas elas tem o mesmo tipo de informação..bem como todas as outras colunas..mas os dados são diferentes!
Então, queria criar uma macro que compilasse todas as informações de todas as planilhas do folder em uma única planilha, para não ter que ficar fazendo ctrl+c e ctrl+v o tempo todo.
é possível criar algo desse tipo? é algo que eu consiga fazer ou algo que apenas alguem muito experiente consiga fazer? Para terem idéia, as planilhas tem cerca de 30 colunas de informação...e a cada mês é adicionado cerca de 20 linhas em cada uma delas.
Aguardo resposta!
Att,
Jorge.
Boa noite!!
Eu nõ sei se eu entendi mas, segue um exemplo de um MVP .
Sub SummaryReport() 'JBeaucaire (6/21/2009) 'Copy rows of data from multiple sheets to one matching one ID # Dim ws As Worksheet, LR As Long, NR As Long 'Setup If SheetExists("Master") Then Sheets("Master").Range("A2:Z" & Rows.Count).ClearContents Else Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Master" Sheets(1).Rows(1).EntireRow.Copy Sheets("Master").Range("A1") End If NR = 2 'Copy data to Report For Each ws In Worksheets If ws.Name <> "Master" Then ws.Activate LR = Range("A" & Rows.Count).End(xlUp).Row Range("A2:Z" & LR).Copy Sheets("Master").Range("A" & NR) NR = NR + LR - 1 End If Next ws End Sub
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Alexandre,
Acho que você entendeu quase toda a ideia, mas, pelo código que eu vi acho que não funciona, devido a ele estar feito em Worksheet! Na verdade eu preciso do código em Workbook!
Em uma mesma pasta terei vários arquivos (pois somos em alguns engenheiros aqui que usam o arquivo estando "offline"). De tempos em tempo preciso compilar as informações de todos os engenheiros em um único arquivo para levantar estatísticas de atendimentos.
Então, são cerca de 5 arquivos na pasta. O padrão de dados dentro do arquivo é igual..ou seja..a Coluna A tem o mesmo tipo de dado em todos..bem como B, C, D...até a Z.
Preciso de uma macro em um arquivo a parte que, quando executada procure em todos os 5 workbooks todas as informações e crie um arquivo geral com todas elas juntas.
Entendeu?
Att,
Jorge.
Boa noite!!
Faça as adaptações necessárias.
Option Explicit Sub Consolidate() 'Author: Jerry Beaucaire' 'Date: 9/15/2009 (2007 compatible) (updated 4/29/2011) 'Summary: Merge files in a specific folder into one master sheet (stacked) ' Moves imported files into another folder Dim fName As String, fPath As String, fPathDone As String Dim LR As Long, NR As Long Dim wbData As Workbook, wsMaster As Worksheet 'Setup Application.ScreenUpdating = False 'speed up macro execution Application.EnableEvents = False 'turn off other macros for now Application.DisplayAlerts = False 'turn off system messages for now Set wsMaster = ThisWorkbook.Sheets("Master") 'sheet report is built into With wsMaster If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then .UsedRange.Offset(1).EntireRow.Clear NR = 2 Else NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'appends data to existing data End If 'Path and filename (edit this section to suit) fPath = "C:2011Files" 'remember final in this string fPathDone = fPath & "Imported" 'remember final in this string On Error Resume Next MkDir fPathDone 'creates the completed folder if missing On Error GoTo 0 fName = Dir(fPath & "*.xls*") 'listing of desired files, edit filter as desired 'Import a sheet from found files Do While Len(fName) > 0 If fName <> ThisWorkbook.Name Then 'don't reopen this file accidentally Set wbData = Workbooks.Open(fPath & fName) 'Open file 'This is the section to customize, replace with your own action code as needed LR = Range("A" & Rows.Count).End(xlUp).Row 'Find last row Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR) wbData.Close False 'close file NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'Next row Name fPath & fName As fPathDone & fName 'move file to IMPORTED folder End If fName = Dir 'ready next filename Loop End With ErrorExit: 'Cleanup ActiveSheet.Columns.AutoFit Application.DisplayAlerts = True 'turn system alerts back on Application.EnableEvents = True 'turn other macros back on Application.ScreenUpdating = True 'refreshes the screen End Sub
Att
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel