Consulting

Results 1 to 2 of 2

Thread: VBA - Copy and Paste Data Base into an existing Sheet

  1. #1

    VBA - Copy and Paste Data Base into an existing Sheet

    Hello everyone

    I tried writing the following code:
    (It was working fine, but whenever I moved the files to another location, the code doesn't work)
    Thank you all in advance. Sorry for the messy code. It's my first attempt on VBA.


    'UnificarPlanilhas Macro
    Sub lsUnificarPlanilhas()
        Application.ScreenUpdating = False
    ' Apagar_Base Macro
    Sheets("Dashboard").Select
        Sheets("Base").Visible = True
        Sheets("Base").Select
        Range("B2:T5000").Select
        Selection.ClearContents
    ' Fim Apagar_Base Macro
    On Error GoTo Sair
    Dim lUltimaColunaAtiva As Long
      Dim lUltimaLinhaAtiva As Long
      Dim lRng As Range
      Dim sPath As String
      Dim fName As String
      Dim lNomeWB As String
      Dim lIPlan As Integer
      Dim lUltimaLinhaPlanDestino As Range
    PlanilhaDestino = ThisWorkbook.Name
    sPath = Localizar_Caminho
    sName = Dir(sPath & "\*.xl*")
    Application.ScreenUpdating = False
      Application.EnableEvents = False
      Application.Calculation = xlCalculationManual
    Do While sName <> ""
            fName = sPath & "" & sName
            Workbooks.Open Filename:=fName, UpdateLinks:=False
    lNomeWB = ActiveWorkbook.Name
    For Each vPlan In Sheets
    vPlan.Visible = True
          Next
    Sheets("Base Mascara").Select
            Range("B2:T350").Select
            Selection.Copy
    Workbooks(PlanilhaDestino).Worksheets("Base").Activate
    Range("B2").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.PasteSpecial xlPasteValues
    Range("A1").Select
    Application.CutCopyMode = False
    Workbooks(lNomeWB).Close SaveChanges:=False
            sName = Dir()
      Loop
    Sair:
      Application.ScreenUpdating = True
      Application.EnableEvents = True
      Application.Calculation = xlCalculationAutomatic
    Range("b4").Select
    Selection.End(xlDown).Select
    Sheets("Base").Select
        ActiveWindow.SelectedSheets.Visible = False
    ' Esconder Aba Ajustado
    Sheets("AJUSTADO").Select
        ActiveWindow.SelectedSheets.Visible = False
    ' Atualizar_Tabela_Dinamica Macro
    ActiveWorkbook.RefreshAll
    ' FIM Atualizar_Tabela_Dinamica Macro
    MsgBox "Planilhas Unificadas e Tabela Atualizada!"
    Application.ScreenUpdating = True
    End Sub
    
    Function gfLetraColuna(ByVal rng As Range) As String
        Dim lTexto() As String
    lTexto = Split(rng.Address, "$")
    gfLetraColuna = lTexto(1)
    End Function
    
    
    Public Function Localizar_Caminho() As String
    Dim strCaminho As String
    With Application.FileDialog(msoFileDialogFolderPicker)
    'Permitir mais de uma pasta
            .AllowMultiSelect = False
    'Mostrar janela
            .Show
    If .SelectedItems.Count > 0 Then
                strCaminho = .SelectedItems(1)
            End If
    End With
    'Atribuir caminho a variável
        Localizar_Caminho = strCaminho
    End Function
    Last edited by Aussiebear; 06-27-2022 at 01:33 PM. Reason: Added code tags and reduced whitespace in supplied code

  2. #2
    i think it has to do with your fName.
    try changing it to:

    Do While sName <> ""
    fName = sPath & "\" & sName

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •