aide pour modifier code vba

[moutchec]

bonjour à tous,
voici un code vba qui sert à importer des colonnes pour l'amélioration duquel j'ai besoin de votre aide.
le code importe données et mise en forme ce qui est parfait mais une fois le lien modifié par exemple la mise en forme reste : première amélioration à apporter = supprimer la mise en forme qui n'a pas de donnée.
deuxième amélioration = faire en sorte que le fichier source puisse se trouver n'importe ou sur le disque dur de l'ordinateur et non uniquement dans le même dossier que le fichier cible.
troisième amélioration = supprimer les lignes dont la cellule en colonne C est vide.
merci d'avance pour votre aide
Moutchec

Private Sub CommandButton1_Click()
Dim CheminSource As String
Dim Ligne As Long, J As Long
Dim Ws As Worksheet

Application.ScreenUpdating = False
Set Ws = ThisWorkbook.Sheets(1)
Ws.Columns("A:M").ClearContents
CheminSource = ThisWorkbook.Path & "\"
Ligne = 1
For J = 2 To Range("N" & Rows.Count).End(xlUp).Row
On Error Resume Next
With Workbooks.Open(CheminSource & Range("N" & J) & ".xlsm")
With .Sheets(1)
.Range("A1:M" & .Range("A" & Rows.Count).End(xlUp).Row).Copy Ws.Range("A" & Ligne)
End With
.Close savechanges:=False
End With
Ligne = Ws.Range("A" & Rows.Count).End(xlUp).Row + 1
Next J

End Sub

 

[Staple1600]

Bonsoir le fil, le forum

Une proposition avec la deuxième amélioration demandée
(puisée en partie dans mes archives poussiéreuses)
Au lancement de la macro, on sélectionne le dossier contenant les fichiers à compiler

Sub CompilerPlusieursFeuillesDansUneSeule()
Dim wbk As Workbook, Ws As Worksheet, FileName$, sPath$, Source As Range

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

With Application.FileDialog(msoFileDialogFolderPicker)
  .Title = "Sélectionner le dossier source, svp."
  .AllowMultiSelect = False
  If .Show <> -1 Then GoTo Suite
  sPath = .SelectedItems(1) & "\"
End With
'Si clic sur Annuler
Suite:
sPath = sPath
If sPath = "" Then GoTo Fin
Set Ws = ThisWorkbook.Sheets(1)
FileName = Dir(sPath & "*.xls?")
  Do While Len(FileName) > 0
  
  Set wbk = Workbooks.Open(sPath & FileName)
  'recopie avec format
  Set Source = wbk.Sheets(1).Range(wbk.Sheets(1).Cells(1, "A"), wbk.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Resize(, 13))
  Source.Copy Ws.Cells(Rows.Count, 1).End(xlUp).Offset(1)
  
  'recopie valeurs seules
  'Set Source = wbk.Sheets(1).Range(wbk.Sheets(1).Cells(1, "A"), wbk.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Resize(, 13))
  'Ws.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(Source.Rows.Count, Source.Columns.Count).Value = Source.Value
  wbk.Close False
  FileName = Dir
  Loop
Fin:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[castor30]

Bonsoir moutchec, Staple,
Essai ceci :

Sub Epure()
' Supprime les lignes si cellules colonne C est vide ""
    'récupère la dernière ligne de l'onglet
    fin = Range("B" & Range("C:C").Rows.Count).End(xlUp).Row
    'pour chaque ligne en partant de la FIN
        For i = fin To 1 Step -1
            'si la cellule en colonne A contient ""
            If Cells(i, "B") Like "" Then
                'on supprime la ligne entière
                Rows(i).EntireRow.Delete
            End If
        Next i
    Columns("B:B").Select
    Selection.FormatConditions.Delete
End Sub

 

[Staple1600]

Bonsoir le fil, le forum

On peut aussi éviter la boucle

Sub Raz_C_Rows()
On Error Resume Next
Range("C1:C" & Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub