HELP... MACROS

Bonsoir,

Consolide les onglets d'un classeur et supprime les lignes vides

Sub consolide_onglets()
Sheets("base").[a2:d1000].ClearContents
For s = 2 To Sheets.Count
n = Range(Sheets(s).[a2], Sheets(s).[A65000].End(xlUp)).Rows.Count
Range(Sheets(s).[a2], Sheets(s).
[A65000].End(xlUp).End(xlToRight)).Copy [A65000].End(xlUp).Offset(1,
0)
[D65000].End(xlUp).Offset(1, 0).Resize(n, 1).Interior.ColorIndex =
_
Sheets(s).[a2].Interior.ColorIndex
[D65000].End(xlUp).Offset(1, 0).Resize(n, 1).Value = Sheets(s).Name
Next s
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

http://cjoint.com/?bCvs1MK0cD

Cordialement JB

On 28 jan, 21:00, val...@hotmail.fr wrote:

BONJOUR MES AMIS J AURAIS BESOIN DE VOTRE AIDE POUR MONTER UNE MACRO
MAI JE SUIS NUL. EN FAI J AIMERAIS POUVOIR COPIER UNE MEME PARTIE
VENUS DE PLUSIEURS WORKSHEET ET LES METTRE A LA SUITE DANS UN AUTRE
WORKBOOK ET EN ELIMINANT TOUTS LES LIGNES VIDES...... JE PENSE QUE J
AURAI BESOIN D UNE BOUCLE CAR JE PENSE QUE DANS LE FUTUR J AURAI
BESOIN D AJOUTER DE NOUVEAU WORKSHEET....

MERCI D AVANCE LES AMIS.....

Selon que tu désires copier les formats de cellules, leur contenu ou
leur formule, tu actives ou désactive ces lignes de code de la procédure
en mettant une apostrophe devant la ligne.

'copie les valeurs
Dest.Range("A" & b).PasteSpecial xlPasteValues
'copie les formats
Dest.Range("A" & b).PasteSpecial xlPasteFormats
'Copie les formules
Dest.Range("A" & b).PasteSpecial xlPasteFormulas

à copier dans un module standard de ton fichier qui
doit recevoir les données.

'--------------------------------
Sub TransfertDeToutesLesFeuillesVersAutreClasseur()

Dim Nb As Long, Dest As Worksheet, R As Long
Dim Wk As Workbook, Sh As Worksheet

Dim Fichier As String ' fichier où sont les données à copier
Dim Chemin As String ' où est situé le fichier
'La macro suppose que le fichier est dans le même répertoire
'que le fichier où vont se copier les données

'Variable à renseigner si leur valeur est différente.
Fichier = "BMR 2007 Resources.xls"
Chemin = ThisWorkbook.Path & ""

'où seront copiées les données
'cette macro est dans un module standard
'dans le même classeur où est ta feuille "N"
Set Dest = ThisWorkbook.Worksheets("N")

Set Wk = Workbooks(Fichier)
If Err <> 0 Then
Err = 0
'si le fichier n'est pas ouvert, ouverture
Set Wk = Workbooks.Open(Chemin & Fichier)
End If

On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ThisWorkbook.Activate
Dest.Select
b = 1
For Each Sh In Wk.Worksheets
With Sh
With .Range("A141:W65536")
R = .Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End With
With .Range("A141:W" & R)
Nb = .Rows.Count
.Copy
End With
Dest.Range("A" & b).Select
'copie les valeurs
Dest.Range("A" & b).PasteSpecial xlPasteValues
'copie les formats
Dest.Range("A" & b).PasteSpecial xlPasteFormats
'Copie les formules
Dest.Range("A" & b).PasteSpecial xlPasteFormulas
b = b + Nb
End With
Next
Dest.Range("A1").Select

End Sub
'--------------------------------






<valeol@hotmail.fr> a écrit dans le message de news:
1170014402.503496.239270@v33g2000cwv.googlegroups.com...
BONJOUR MES AMIS J AURAIS BESOIN DE VOTRE AIDE POUR MONTER UNE MACRO
MAI JE SUIS NUL. EN FAI J AIMERAIS POUVOIR COPIER UNE MEME PARTIE
VENUS DE PLUSIEURS WORKSHEET ET LES METTRE A LA SUITE DANS UN AUTRE
WORKBOOK ET EN ELIMINANT TOUTS LES LIGNES VIDES...... JE PENSE QUE J
AURAI BESOIN D UNE BOUCLE CAR JE PENSE QUE DANS LE FUTUR J AURAI
BESOIN D AJOUTER DE NOUVEAU WORKSHEET....

MERCI D AVANCE LES AMIS.....